diff --git a/applications/lazstats/Options.txt b/applications/lazstats/Options.txt new file mode 100644 index 000000000..af26b5178 --- /dev/null +++ b/applications/lazstats/Options.txt @@ -0,0 +1,5 @@ +1 +0 +3 +2 +D:\Prog_Lazarus\wp-git\LazStats diff --git a/applications/lazstats/README.txt b/applications/lazstats/README.txt new file mode 100644 index 000000000..171e19c3e --- /dev/null +++ b/applications/lazstats/README.txt @@ -0,0 +1,14 @@ +-------------------------------------------------------------------------------- +LazStats +-------------------------------------------------------------------------------- +Clone of the LazStats statistics application by William Miller +(https://openstat.info/LazStatsMain.htm) + +What is different? +------------------ +- Updated form layout. +- Units into subfolders for each major menu command in order to avoid the + extremely long file list in the project manager. +- Include data and html folder of the original site. Add data file from the + OpenStat application mentioned in the pdf help files. +- Create chm help from the original pdf help files, tool used: HelpNDoc. diff --git a/applications/lazstats/docs/HelpNDoc/LazStats.hnd b/applications/lazstats/docs/HelpNDoc/LazStats.hnd new file mode 100644 index 000000000..b142fcb15 Binary files /dev/null and b/applications/lazstats/docs/HelpNDoc/LazStats.hnd differ diff --git a/applications/lazstats/docs/chm/LazStats.chm b/applications/lazstats/docs/chm/LazStats.chm new file mode 100644 index 000000000..730843774 Binary files /dev/null and b/applications/lazstats/docs/chm/LazStats.chm differ diff --git a/applications/lazstats/source/LazStats.ico b/applications/lazstats/source/LazStats.ico new file mode 100644 index 000000000..0341321b5 Binary files /dev/null and b/applications/lazstats/source/LazStats.ico differ diff --git a/applications/lazstats/source/LazStats.ini b/applications/lazstats/source/LazStats.ini new file mode 100644 index 000000000..aee3e8e66 --- /dev/null +++ b/applications/lazstats/source/LazStats.ini @@ -0,0 +1,64 @@ +[LANGUAGE] +DEFAULT=ENGLISH +[ENGLISH] +101=Directions: For entry of data on this form, enter the number of rows, columns and slices in the boxes provided. Press enter after each entry. Then enter the frequencies observed for each cell in the grid. If entering data from a file in the main grid, select the row, column, slice and frequency variables by selecting from the list of variables and clicking the right-arrow for the corresponding variable. Click the compute button to obtain the results. +102=The AxBxR ANOVA involves two between treatment factors and repeated measures factors. Two grid column variables contain the A and B treatment values (codes 1, 2, etc.) and 2 to K grid column variables for the repeated measure observations. All ABC groups are assumed to be of the same size. There is a maximum of 20 repeated measures. +103=This procedure analyzes fixed effects with up to three levels of interaction and one or more covariates. Multiple regression methods are used (See "Multiple Regression in Behavioral Research" by Elazar J. Pedhazur, Harcourt, Brace, College Publishers, 1997, Chapter 16, pages 675-713.) A test is performed for the assumption of homogeneous regression slopes in addition to the ANCOVA. Both adjusted and unadjusted means are reported. Comparisons are made among the adjusted means. +104=Directions: Select a variable to analyze. You may analyxe series from either a column (default) or a "Case" row. You may elect to analyze all values in a column (or row) as desiredClick the buttons for any desired smoothing options. The program will automatically "split" the list of row values (or column values) for that variable into two sub-sets of X and Y scores with each Y score being the value which "lags" behind the X score in the list by k lag values. All possible lags which yield a sample as large as 3 or more are computed and plotted in a "correlogram". You may optionally print the lag, +correlation, means, standard deviations and confidence interval for each correlation. The differences between original and smoothed values (residuals) may be plotted. The smoothed points replace the original values in the analysis if smoothing is elected. +105=The main grid should contain a symetric matrix of similarity or dissimilarity values representing distances among the objects to be clustered. Check the type box io indicate if the measures are similarities (e.g. correlations) or dissimilarities. +106=Directions: It is assumed you have one grid column variable representing the group codes for the (A) between treatment groups effect and 2 to k column variables representing the repeated measures. Group codes should be sequential values of 1, 2, etc. You may elect to plot the means. +107=Directions: You may elect to complete a 1, 2 or 3 way ANOVA by selecting a dependent variable and 1, 2 or 3 factor variables. If you elect post-hoc tests, comparisons are made between factor levels. NOTE: some post-hoc comparisons are made only with equal N's. +108=Directions: First click on the variable name that represents the group codes. Next, click on the variable that reresents the measurement to be plotted. Click the Compute button to obtain the results. You can obtain a single boxplot for all cases if you use a "dummy" group variable containing only the group code 1 for all cases. +109=Directions: First, select the categorical variables of your study. Select them in the order of the desired breakdown. Next, slect the continuous variable for which you want statistics for each cell obtained by by breaking down the categorical variables into their respective categories. +110=Directions: 1. Select the variable containing the bubble identification mumber - an integer in the range of 1 to N objects. 2. Select the variable representing the X axis integer value for the object. This is the repeated measures variable. 3. Select the variable representing the Y axis. This should be a floating point value. 4. Select the variable representing the size of the bubble for each object to be plotted at the X and Y location. NOTE: Each data line reresents one replication (X value) of the object plotted. See the example data in the file labeled BubblePlot.LAZ +111=NOTE: No. of left hand variables must be less than or equal to the number of right hand variables. +112=Directions: Click on the variable that represents the measurement. Click on the Sigma button to change the default value. Click the Compute button to obtain the results. +113=Directions: Two to k variables representing dichotomous (0,1) values are analyzed for N cases. The values of the variables reflect repeated observations on the same subjects or on matched subjects. Click the variables on the left to analyze and enter them by clicking the right arrow button. +114=Directions: Forst select the test scores from the available variables. You will see a default reliability and weight ssigned to each score selected in list boxes to the right. If you click on either a reliability or a weight, an input box will appear in which you can enter a new reliability or weight. Note - you can use the KR#21 reliability program to estimate reliability if you know the maximum score. +115=Directions: A Judge's ratings or observations are recorded as variables (columns) 1 through k. Each line conrresponds to a different judge (person making the rating.) Select the variables from the left list to analyze and click on the right arrow button to enter them. To remove a variable from the list of selected ones, click on the variable name in the selected list and click the left arrow button. Click the Compute button to obtain the results. +116=Directions: Select each categorical variable from the available variables in the leftmost box in the order that you wish to have the breakdown proceed. Click the OK button to start the analysis. +117=Directions: First, click on the variable name that represents the sample lot number. Next, click on the variable that represents the measurement. Click on the Delta size and enter the desired value. Click on the alpha and/or beta probability boxes and enter values to change from the default values. You may also enter target specifications if you first click the check box to use a target specification. +118=Description: Double Declining Value determines accelerated depreciation values for an asset given the initial cost, life expectancy, and value, and depreciation period. EXAMPLE: What is the depreciation value for a computer with a life expectancy of three years if it initially cost $2,000.00 with no expected value at the end of the three years? Initial Cost = 2000.00 Life Expectancy = 3 End Value = 0.0 Depreciation Period = 3 ANSWER: $148.15 +119=This procedure provides means, variances, standard deviations, skewness, kurtosis and range values for each variable selected. Select the variables in the left list and enter them for analysiis by clicking the right arrow. If you select the z score option, a new variable will be added to your grid for each variable you select. The new variable will contain the transformation of the original variable into a z score. +120=Each row of the grid below corresponds to one column of the data grid. Complete the information requested in each cell of the row. To add another variable (row in the dictionary), press the down-arrow on your keyboard. +121=Directions: Specify the lag value for the differences desired, e.g. 1 to obtain the difference between point 1 and 2, 2, and 3, etc. Also, indicate the order, i.e. the number of times to repeat the differencing operation. Click OK when ready. +122=This procedure is an adaptation of the program written by Niels G. Waller, Dept. of Psychology, University of California-Davis, Jan. 1998. It's purpose is to identify test items that differ in the response pattern for two groups: a reference group and a focal group. The file of data to be analyzed should consist of a variable containing a code designating the two groups and variables containing subject's item responses coded 0 for incorrect and 1 for correct. No missing data may be included. The results provide the Mantel-Haenszel statistics for identifying those items which are different for the two groups. +123=Directions: The number of intervals may not exceed the number of cses. To change the interval size, click on the current size and replace it with a new size. Press the enter button after entering a new value. +124=Directions: The two way ANOVA on ranks is similar to a mixed design ANOVA with repeated measures (1 to k conditions) on ssubjects in 1 to M groups. The program expects one variable to represent the group code, and 1 to k score variables for each case. The scores for the cases in each group are used to obtain rankings among the k scores within each group. The test is whether or not the rank totals for the conditions are equal within the expected sampling variability. +125=This procedure calculates the Kappa coefficient for objects or subjects classified into two or more categories by a group of judges or procedures. Each object is coded with a sequential integer ranging from 1 to the number of objects. Each judge is also coded with an integer from 1 to the number of judges. Categories are numbered with integers from 1 to the number of categories. These are column variables. It is expected that the total number of cases will be the number of judges times the number of objects. +126=Directions: he GLM procedure permits the user to specify multiple dependent variables and multiple independent variables. Variables for both dependent and independent may be either continuous or categorical variables. The independent variables are classified as fixed effects, random effects, repeated measures or covariates. Interactions among the independent variables may be specified for the model used. To define an interaction in your model, click the start definition button and then click on each independent variable to be included in the interaction. Click the end definition button to end the definition. A maximum of 5 terms is allowed in an interaction. +127=You may obtasin results for a single group or for experimental and control groups. If there is only one group, leave the group variable blank. Data entered on each line of the data grid represent one case within a group. You will typically have two or three columns of data with variable labels like "TIME", "GROUP" and "EVENT". Each variable should be defined as an integer in your variable definitions. Note that the code for experimental and control groups are 1 and 2. The coding for the event or censored is 1 for the event (death) and 2 for the censored (lost, can't observe.) An example file with the name "KaplanMeierTest.LAZ is available for use. +128=This procedure provides both the weighted and unweighted Kappa Coefficients for assessing the consistency of judgements for two raters. It also provides other measures of the independence of the ratings. If nominal categories are used in the ratings, the unweighted statistic is appropriate. If the categories represent ordinal data, the weighted Kappa statistics may be appropriate. The number of rows must equal the number of columns to calculate the Kappa statistics. +129=The main grid should contain data values representing variables meansured on the objects to be clustered (rows.) Enter the desired number of clusters, select the variables to use in clustering and select the options desired. +130=See B. J. Winer's "Statistical Principles in Experimental Design", McGraw-Hill Book Company, New York, 1962, pages 514-577 for the analyses plans provided in this procedure. Note: Factor codes should be formatted as integers, data values as floating point values. All cell sizes should be equal and no missing values are allowed. +131=Complete the specifications for your log-linear analysis of cross-classivation data as indicated below. Complete step 1, step 2 and step 3. Select any options desired. Click the Compute button to obtain the results. Should you need to start over, click the Reset button. When your analysis or analyses are commpleted, click the Return button. +132=Directions: Enter the order of the moving averae. The order is the number of values on each side of a point to be included in the average. When you enter a value, a list of corresponding thetas will appear in the list. Click on each theta of the list for entry of the desired weight (default 1.0). Enter a weight in the theta value box and press the enter key. Repeat for each theta in the list. Click the Apply button when ready. The theta values will be re-proportioned to sum to 1.0 accross all values. Click the OK button to continue. +133=Directions: You may generate sample multivariate data from a population with known intercorrelation among the variables and with known population means and standard deviations. Enter the number of variables and size of the sample to generate. Then enter the correlations among the variables row-wise the program will fill in the lower triangular values.) Next, enter the population means and standard deviations. When ready to generate the data, click the ComputeBtn. The data will be placed in the data grid. You can save this data to a file. +134=Directions: 1. Select the X Variable 2. Select the Y variable 3. Select the group variable (integer) 4. Enter a label for the plot 5. Select an option if desired. 6. Click the Compute button +135=If you use a language that uses the comma (,) separator to separate the whole part from the fractional part of a number (e.g. 123,45) then select the EUROPEAN option. The default is the English convention (a period, e.g. 123.45). You can enter a default directory to locate your data files. Click a button for values that represent a missing value and click a button that indicates how you want to display values in a grid cell (justification.) +136=For partial and semi-partial correlations, select the dependent variable then select the predictor variable(s), and finally the variable(s) to be partialled. Note that simple, higher order and multiple simple and higher order partialling may be completed as a function of the number of predictors and partialled variables included in the analysis. +137=Directions: The p Chart for nonconforming parts assumes you have a variable (column of data) which represents the number of nonconforming parts in a sample lot of size N. You are expected to enter the sample size N in which each of the observations was made. You will also need to enter P, the expected or target proportion of defects in a sample of N parts. To select the measurement variable, click on the name of the variable in the list of variables available. Enter the N and P values in the boxes provided. If you desire a sigma value other than the default, click the desired button. Click the Compute button to obtain the results. +138=Directions: To use the program you should have the following values coded for each subject: (1) a variable (1/2) for the reference or focus group. (2) one or more items which contain an item score (integers representing response categories, e.g. a value from 1 to 5. Follow these steps to complete the analysis: (1) Enter the items in the available variables list into the selected items list. (2) Enter the group variable from the available variables list to the group box. (3) Enter the Lowest Item Score in the corresponding box. (4) Enter the highest Item Score in the corresponding box. (5) Enter the Reference Group Code in its box. (6) Enter the Focal Group Code in its box. (7) Enter the number of levels of total scores to analyze in the corresponding box. (8) For each level, enter the minimum and maximum scores. Click the scroll bar to go to the next level. You may need to click the down end of the scroll bar to correct errors or change minimum and maximum values for a level. +139=Directions: In polynomial regression smoothing, the value of a point y at a given time t is estimated by the sum of regression weights times t raised to a power of 1, 2, etc. up to the order specified. Enter the order and click the OK button. +140=Directions: Cases should consist of k dichotomous item scores (0 and 1 scores.) You can use the Classical Test program to score your test and save the item scores to the grid if necessary. +141=Directions: First, click on the variable name that represents the sample lot number. Next, click on the variable that represents the measurement. Click on the sigma button to change the default and click on any of the optional check boxes and enter specifications desired. Click the Compute button to obtain the results. Up to 200 groups may be analyzed. Note! Equal group sizes of 2 to 25 required for ranges analysis. Control limits are plus and minus 3 sigma. +142=R = 1 - (s2 / S2) x (1 - r) where R is the estimated reliability of a test obtained on a new group with variance S2 when a reliability of r was obtained for the same test on a group with variance s2. It is assumed the difference in variance is due soley to the difference in true score variance of the two groups. See Theory of Mental Tests by H. Guliksen, 1950. +143=Directions: Your data grid should consist of a table of N rows and M+1 column variables. Each row should have a string type label variable and M columns of integer frequency data. 1. Enter the variable for the row labels (strings) 2. Enter the variables representing the columns of frequency integers 3. Select the Options desired 4. If only one variable is to be considered the reference variable, click the button labeled "Use Only the reference variable selected and click on one of the column variables just selected to represent the reference distribution. 5. If each column variable is to be considered as a reference variable, click on the other button labeled "Let each variable be a reference variable" 6. Change the alpha level for significance if desired. 7. Check the Bonferroni contrasts if desired. 8. Click the Compute button to obtain the results. +144=This procedure calculates the Pearson Product-Moment correlation coefficients for two or more variables. If one or more of the variables selected have been filtered out or contain a missing value, the case containing that variable will not be included in the analysis (list-wise deletion.) You may elect to obtain not only the correlations but also the raw cross-products, the variance-covariance matrix and the means, variances and standard deviations of the variables. Click on the variable in the list to the left and enter it for analysis by clicking the right arrow box. Repeat this for each variable to be included or click the ALL button to include all variables. +145=Directions: First click on the variable name that represents the sample lot number. Next, click on the variable that represents the measurement. Click the Compute Button to obtain the results. NOTE! Equal group (lot) sizes of 2 to 25 required for Sigma analysis. Control limits are plus and minus 3 sigma. Up to 200 lots may be analyzed. +146=Description: Straight Line Depreciation calculates the depreciation allowance for an asset over one period in it's life. The function divides the cost minus the salvage value by the number of years of useful life of the asset. Cost is the inital amount paid for the asset. Salvage is the value left at the end of the asset's life. EXAMPLE: What is the depreciation value on might expect for a computer purchased for $2,000.00 and expected to have a useful life of three years with no residual value? ANSWER: Approximately $666.67 +147=R = Kr / (1 + (K - 1) r where R is the estimated reliability of a test when increased by a factor of K. K is the number of items in the lengthened test divided by the number of items in the original test. r is the reliability of the original test. +148=Directions: Click on the variables from the left list of available variables. Click the right-pointing arrow to enter your selection(s). You can remove a selected variable by clicking on it and click the left-pointing arrow button. Click the Compute button to do the analysis. NOTE: Some leaves may represent fragments smaller than the leaf depth. +149=Description: Sum of Years Digits Depreciation calculates depreciation amounts for an asset using an accelerated depreciation method. This allows for higher depreciation in the early years of an asset's life. Cost is the initial cost of the asset. Salvage is the value of the asset at the end of it's life expectancy. Life is the length of the asset's life expectancy. Period is the period that you wish to calculate the depreciation. EXAMPLE: What is the depreciation for period 1, 2 or 3 that one can claim for a computer purchased at a price of $2,000.00 and expected to have a useful life of 3 years with no salvage value? ANSWER: $1,000.00 the first year, $666.67 the second period and $333.33 the last year. +150=New variables may be created that are transformations of an existing variable or a combination of two variables or a variable and a constant. For example, you may want to create a new variable that is the natural log of an existing variable. As another example, you may want to create a variable that is the product of two other variables. To create the new variable, enter a name for the new variable in the edit box provided for the new variable name. Next, select the transformation in the list of functions available. The selected transformation will be shown in a box below the list of functions. Next, click on the name of the variable for the first arguement of the function to be performed and use the corresponding right arrow button to enter it. If a second variable is required (V2) click on the name of the variable and enter it with the corresponding arrow for V2. If a constant is required, click on the constant edit box and enter the value. Click on the Compute button. +151=Directions: For Dependent samples, click on the three variables representing X, Y and Z (in that order.) The test will compare the r(x,y) with the r(x,z). For Independent samples, click on the X and Y variables to be correlated and then the variable representing the group coding variable. The correlations obtained in each of two groups will be compared. +152=Directions: For independent groups you should have a variable indicating group membership using 1 and 2 for the group codes and a variable with 0 or 1 values which represent observed or not observed in the group. For dependent proportions you should have two variables code with 0 or 1 in each case. +153=Select the Dependent Variable and enter it in its box. Select the predictors (including the ones dependent on the instrumental variables) and enter them in the explanatory list. Copy the predictors dependent on the instrumental variables to the Instrumental Variables list. Add the instrumental variables to the same list. Select options desired and click the Compute button. NOTE: The number of variables in the Instrumental list should be equal to or greater than the Explanatory list. +154=Directions: Data may be entered on this form or from a file loaded in the grid. First, enter the number of rows and columns pressing the return key after each entry. If entering Grid data, click on the variables corresponding to row, column and frequency data. If entering on this form, enter the frequencies in the cells corresponding to the row and column of your data. +155=Directions: Click on the variable that represents the count of defects. Enter the number inspected in each subgroup (lot.) Note - all groups are of equal size. Click on a Sigma button to change to a different value. You may enter a specific value if you choose the X sigma option. Click the Compute button to see the results. +156=Directions: First click on one of the variables representing matched pairs of observations from the list of available variables. Click the right-pointing button to enter your choice for variable 1. Repeat for the second variable. Click the Compute button to obtain the results. +157=Directions: The repeated measures ANOVA requires you to select two or more variables (columns) which represent repeated observations on the same subjects (rows.) Homogeneity of variance and covariance are assumed and may be tested as an option. In addition, the ANOVA provides the basis for estimates of reliability as developed by Hoyt (Intraclass reliability) with the adjusted estimate equivalent to the Cronbach Alpha estimate. Finally, you may elect to plot the means obtained for the repeated measures. +158=Weighted Least Squares Regression lets you save the residuals and squared residuals for an OLS weighted analysis. You may also complete a regression of these residuals on the independent variables and save the residuals and squared residuals from those analyses. The square root of the reciprocal of the absolute squared residuals from this last analysis may be used as weights to reduce the heteroscedasticity in your data. If this option is chosen, an OLS regression of the weighted variables is conducted. This may be done through the origin. +159=Directions: Firs, click in the variable name that represents the sample lot numbers. Next, click on the variable that represents the measurement. Click on the sigma button to change the default and click on any of the optional check boxes and enter specifications desired. Click the Compute button to obtain the results. +160=Correspondence analysis is a method for examining the relationship between two sets of categorical variables much as in a Chi-Squared analysis of a two-way contingency table. In fact, a typical chi-squared analysis is completed as part of this procedure. In addition, visualization of the relationships among the columns or rows of the analysis is performed in a manner similar to factor analysis. The data analyzed in the visualization is the table of relative proportions, that is, the original frequency values divided by the sum of all frequencies. The relative proportions of the row sums and the column sums are termed the “masses” of the rows or columns. The method used to analyze the relative proportions involves what is now called the “Generalized Singular Value Decomposition” or more simply the generalized SVD. This method obtains roots and vectors of a rectangular matrix by decomposing that matrix into three portions: a matrix of left singular column vectors (A) that has n rows and q columns (n ³ q), a square diagonal matrix with q rows and columns of singular values (D), and a transposed matrix (B’) that is m x q in size of right generalized singular vectors (m = q-1). Completing this analysis involves several steps. The first is to obtain the (regular) SVD analysis of a matrix Q defined as Dr-1/2PDc -1/2 where Dr and Dc are diagonal matrices of row and column relative proportions and P is the matrix of relative proportions. The SVD of Q gives Q = U D V’ where D is the desired diagonal matrix of eigenvalues and U’U = V’V = I. It should be noted that the first of the q roots is trivial and to be ignored. At this point we obtain A = Dr1/2U and B = Dc 1/2 V. The results of this SVD analysis is available on the output. Now P = ADB’. The row coordinates F and column coordinates G are then computed according to the table: Analysis Choice Button Selected Row Coordinates Column Coordinates Row Profile Row F = Dr-1AD G = Dc-1B Column Profile Column F = Dr-1A G = Dc-1BD Both Profiles Both F = Dr-1AD G = Dc-1BD If Row profiles are computed, the row coordinates are weighted centroids of the column coordinates and the inertias D2 refer only to the row points. If the column profiles are computed, the column coordinates are weighted eentroids of the row coordinates and the inertias D2 refer only to the column points. If both profiles are selected, neither row or column coordinates are weighted centroids of the other but the inertias D2 refer to both sets of points. The q-1 inertias are plotted in a manner similar to a scree plot of roots in a factor analysis. The total inertia is, in fact, the chi-squared statistic divided by the total of all cell frequencies. You may elect to plot the coordinates for any two pairs of coordinates. This will provide a graphical representation of the separation of the row or column categories similar to a plot of variables in a discriminant function analysis or factors in a factor analysis. A way of looking at correspondence analysis is to consider it as a method for decomposing the overall inertia by identifying a small number of dimensions in which the deviations from the expected values can be represented. This is similar to factor analysis where the total variance is decomposed so as to arrive at a lower dimensional representation of variables. diff --git a/applications/lazstats/source/LazStats.lpi b/applications/lazstats/source/LazStats.lpi new file mode 100644 index 000000000..97b7f1289 --- /dev/null +++ b/applications/lazstats/source/LazStats.lpi @@ -0,0 +1,1441 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/applications/lazstats/source/LazStats.lpr b/applications/lazstats/source/LazStats.lpr new file mode 100644 index 000000000..e995850f7 --- /dev/null +++ b/applications/lazstats/source/LazStats.lpr @@ -0,0 +1,34 @@ +program LazStats; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, + Globals, LicenseUnit, OptionsUnit, MainDM, MainUnit; + +{$R LazStats.res} + +begin + RequireDerivedFormResource := True; + Application.Title:=''; + Application.Scaled:=True; + Application.Initialize; + + LoadOptions; + if not LoggedOn then + begin + if AcceptLicenseForm then + LoggedOn := true + else + Application.Terminate; + end; + + Application.CreateForm(TMainDataModule, MainDataModule); + Application.CreateForm(TOS3MainFrm, OS3MainFrm); + Application.Run; +end. + diff --git a/applications/lazstats/source/LazStats.res b/applications/lazstats/source/LazStats.res new file mode 100644 index 000000000..bec39b4a4 Binary files /dev/null and b/applications/lazstats/source/LazStats.res differ diff --git a/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.lfm new file mode 100644 index 000000000..68d5b0b40 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.lfm @@ -0,0 +1,439 @@ +object ABCNestedForm: TABCNestedForm + Left = 529 + Height = 640 + Top = 153 + Width = 479 + AutoSize = True + Caption = 'ABCNestedForm' + ClientHeight = 640 + ClientWidth = 479 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 266 + Height = 25 + Top = 607 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 2 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 328 + Height = 25 + Top = 607 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 3 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 412 + Height = 25 + Top = 607 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 4 + end + object OptionsBox: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 72 + Top = 519 + Width = 463 + Anchors = [akLeft, akRight, akBottom] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'OptionsBox' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 16 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 52 + ClientWidth = 459 + Columns = 2 + Items.Strings = ( + 'Plot means using 2D Horizontal Bars' + 'Plot means using 3D Horizontal Bars' + 'Plot means using 2D Vertical Bars' + 'Plot means using 3D Vertical Bars' + ) + TabOrder = 1 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 591 + Width = 479 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 180 + Top = 8 + Width = 463 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Directions: This analysis assumes that levels of Factor B are Nested within levels of Factor A. It is assumed that all factors are fixed level factors.'#13#10#13#10'The variables for the group coding should be defined as integers. The dependent variable should be defined as a floating point variable. The number of cases for each ABC group should be equal and the number of B treatments in in each A level should be equal. The number of C treatment levels should be the same for each AB combination.'#13#10#13#10'Click the variable for each factor variable and the corresponding arrow to enter it in the edit box for that variable. Select the type of plot desired for the means (if any.) Click the Compute button to continue.' + ParentColor = False + WordWrap = True + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = OptionsBox + Left = 8 + Height = 307 + Top = 204 + Width = 463 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 307 + ClientWidth = 463 + TabOrder = 0 + object Label2: TLabel + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = FactorAEdit + Left = 253 + Height = 15 + Top = 25 + Width = 88 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor A Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = FactorBEdit + Left = 253 + Height = 15 + Top = 101 + Width = 115 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor B (Nested in A)' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = DepEdit + Left = 253 + Height = 15 + Top = 253 + Width = 102 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AInBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 290 + Top = 17 + Width = 209 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object AInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 217 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = AInBtnClick + Spacing = 0 + TabOrder = 1 + end + object AOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = AInBtn + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = AOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object BInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = AOutBtn + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 28 + Top = 93 + Width = 28 + BorderSpacing.Top = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = BInBtnClick + Spacing = 0 + TabOrder = 4 + end + object BOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = BInBtn + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 28 + Top = 125 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = BOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object DepInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = COutBtn + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 28 + Top = 245 + Width = 28 + BorderSpacing.Top = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInBtnClick + Spacing = 0 + TabOrder = 10 + end + object DepOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepInBtn + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 28 + Top = 277 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutBtnClick + Spacing = 0 + TabOrder = 11 + end + object FactorAEdit: TEdit + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = AOutBtn + AnchorSideBottom.Side = asrBottom + Left = 253 + Height = 23 + Top = 42 + Width = 210 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'FactorAEdit' + end + object FactorBEdit: TEdit + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = BOutBtn + AnchorSideBottom.Side = asrBottom + Left = 253 + Height = 23 + Top = 118 + Width = 210 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'FactorBEdit' + end + object DepEdit: TEdit + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOutBtn + AnchorSideBottom.Side = asrBottom + Left = 253 + Height = 23 + Top = 270 + Width = 210 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 12 + Text = 'DepEdit' + end + object CInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = BOutBtn + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 28 + Top = 169 + Width = 28 + BorderSpacing.Top = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = CInBtnClick + Spacing = 0 + TabOrder = 7 + end + object COutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = CInBtn + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 28 + Top = 201 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = COutBtnClick + Spacing = 0 + TabOrder = 8 + end + object FactorCEdit: TEdit + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = COutBtn + AnchorSideBottom.Side = asrBottom + Left = 253 + Height = 23 + Top = 194 + Width = 210 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 9 + Text = 'FactorCEdit' + end + object Label5: TLabel + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = FactorCEdit + Left = 253 + Height = 15 + Top = 177 + Width = 88 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor C Variable' + ParentColor = False + end + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 100 + Caption = 'Available Variables:' + ParentColor = False + end + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.pas b/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.pas new file mode 100644 index 000000000..f5e38471b --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/abcnestedunit.pas @@ -0,0 +1,1000 @@ +unit ABCNestedUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, GraphLib, Globals; + +type + + { TABCNestedForm } + + TABCNestedForm = class(TForm) + Bevel1: TBevel; + FactorCEdit: TEdit; + FactorAEdit: TEdit; + AInBtn: TBitBtn; + AOutBtn: TBitBtn; + FactorBEdit: TEdit; + BInBtn: TBitBtn; + BOutBtn: TBitBtn; + ComputeBtn: TButton; + DepEdit: TEdit; + DepInBtn: TBitBtn; + CInBtn: TBitBtn; + DepOutBtn: TBitBtn; + COutBtn: TBitBtn; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Memo1: TLabel; + OptionsBox: TRadioGroup; + Panel1: TPanel; + ResetBtn: TButton; + CloseBtn: TButton; + VarList: TListBox; + procedure AInBtnClick(Sender: TObject); + procedure AOutBtnClick(Sender: TObject); + procedure BInBtnClick(Sender: TObject); + procedure BOutBtnClick(Sender: TObject); + procedure CInBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure COutBtnClick(Sender: TObject); + procedure DepInBtnClick(Sender: TObject); + procedure DepOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + + private + { private declarations } + FAutoSized: Boolean; + CellCount: IntDyneCube; + ASS, BSS, CSS, ASumSqr, BSumSqr, CSumSqr, AMeans, BMeans, ASDs : DblDyneVec; + CMeans, BSDs, CSDs : DblDyneVec; + ACSS,ACSumSqr, ACMeans, ACSDs, ABSS, ABSumSqr, ABMeans, ABSDs : DblDyneMat; + ACount, BCount, CCount : IntDyneVec; + ACCount, ABCount : IntDyneMat; + CellSDs, SS, SumSqr, CellMeans : DblDyneCube; + MinA, MinB, MaxA, MaxB, NoALevels, NoBLevels, ACol, BCol, YCol : integer; + CCol, MinC, MaxC, NoCLevels : integer; + DepVar, FactorA, FactorB, FactorC : string; + SSTot, SumSqrTot, TotMean, MSTot, SSA, MSA, SSB, MSB, SSW, MSW : double; + SSC, MSC, SSAC, MSAC, SSBwAC, SSAB, MSBwAC : double; + TotN, dfA, dfBwA, dfwcell, dftotal, dfC, dfAC, dfBwAC : integer; + ColNoSelected : IntDyneVec; + + function GetVars: Boolean; + procedure GetMemory; + procedure GetSums; + procedure ShowMeans(AReport: TStrings); + procedure GetResults; + procedure ShowResults(AReport: TStrings); + procedure ReleaseMemory; + procedure TwoWayPlot; + + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + ABCNestedForm: TABCNestedForm; + +implementation + +uses + Math; + +{ TABCNestedForm } + +procedure TABCNestedForm.ResetBtnClick(Sender: TObject); +VAR + i : integer; +begin + VarList.Items.Clear; + FactorAEdit.Text := ''; + FactorBEdit.Text := ''; + FactorCEdit.Text := ''; + DepEdit.Text := ''; + AInBtn.Enabled := true; + AOutBtn.Enabled := false; + BInBtn.Enabled := true; + BOutBtn.Enabled := false; + CInBtn.Enabled := true; + COutBtn.Enabled := false; + DepInBtn.Enabled := true; + DepoutBtn.Enabled := false; + OptionsBox.ItemIndex := 3; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + OptionsBox.ItemIndex := 3; +end; + +procedure TABCNestedForm.AInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (FactorAEdit.Text = '') then + begin + FactorAEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TABCNestedForm.AOutBtnClick(Sender: TObject); +begin + if FactorAEdit.Text <> '' then + begin + VarList.Items.Add(FactorAEdit.Text); + FactorAEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TABCNestedForm.BInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (FactorBEdit.Text = '') then + begin + FactorBEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TABCNestedForm.BOutBtnClick(Sender: TObject); +begin + if FactorBEdit.Text <> '' then + begin + VarList.Items.Add(FactorBEdit.Text); + FactorBEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TABCNestedForm.CInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (FactorCEdit.Text = '') then + begin + FactorCEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TABCNestedForm.ComputeBtnClick(Sender: TObject); +var + lReport: TStrings; +begin + lReport := TStringList.Create; + try + if GetVars then + begin + GetMemory; + GetSums; + ShowMeans(lReport); + GetResults; + ShowResults(lReport); + TwoWayPlot; + ReleaseMemory; + end; + finally + lReport.Free; + end; +end; + +procedure TABCNestedForm.COutBtnClick(Sender: TObject); +begin + if FactorCEdit.Text <> '' then + begin + VarList.Items.Add(FactorCEdit.Text); + FactorCEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TABCNestedForm.DepInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepEdit.Text = '') then + begin + DepEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TABCNestedForm.DepOutBtnClick(Sender: TObject); +begin + if DepEdit.Text <> '' then + begin + VarList.Items.Add(DepEdit.Text); + DepEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TABCNestedForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TABCNestedForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +function TABCNestedForm.GetVars: Boolean; +var + i, group: integer; + strvalue, cellstring: string; +begin + Result := false; + + SetLength(ColNoSelected,4); + DepVar := DepEdit.Text; + FactorA := FactorAEdit.Text; + FactorB := FactorBEdit.Text; + FactorC := FactorCEdit.Text; + ACol := 0; + BCol := 0; + CCol := 0; + YCol := 0; + MinA := 1000; + MaxA := -1000; + MinB := 1000; + MaxB := -1000; + MinC := 1000; + MaxC := -1000; + for i := 1 to NoVariables do + begin + strvalue := Trim(OS3MainFrm.DataGrid.Cells[i,0]); + if FactorA = strvalue then + begin + ACol := i; + ColNoSelected[0] := i; + end; + if FactorB = strvalue then + begin + BCol := i; + ColNoSelected[1] := i; + end; + if FactorC = strvalue then + begin + CCol := i; + ColNoSelected[2] := i; + end; + if DepVar = strvalue then + begin + YCol := i; + ColNoSelected[3] := i; + end; + end; + if (ACol = 0) or (BCol = 0) or (CCol = 0) or (YCol = 0) then + begin + MessageDlg('Select a variable for each entry box.', mtError, [mbOK], 0); + exit; + end; + + // get number of levels for Factors + for i := 1 to NoCases do + begin + cellstring := Trim(OS3MainFrm.DataGrid.Cells[ACol,i]); + group := round(StrToFloat(cellstring)); + if (group > MaxA) then MaxA := group; + if (group < MinA) then MinA := group; + + cellstring := Trim(OS3MainFrm.DataGrid.Cells[BCol,i]); + group := round(StrToFLoat(cellstring)); + if (group > MaxB) then MaxB := group; + if (group < MinB) then MinB := group; + + cellstring := Trim(OS3MainFrm.DataGrid.Cells[CCol,i]); + group := round(StrToFLoat(cellstring)); + if (group > MaxC) then MaxC := group; + if (group < MinC) then MinC := group; + end; + + NoALevels := MaxA - MinA + 1; + NoBLevels := MaxB - MinB + 1; + NoCLevels := MaxC - MinC + 1; + + Result := true; +end; + +procedure TABCNestedForm.GetMemory; +begin + SetLength(SS,NoBLevels,NoALevels,NoCLevels); + SetLength(SumSqr,NoBLevels,NoALevels,NoCLevels); + SetLength(CellCount,NoBLevels,NoALevels,NoCLevels); + SetLength(CellMeans,NoBLevels,NoALevels,NoCLevels); + SetLength(CellSDs,NoBLevels,NoALevels,NoCLevels); + SetLength(ASS,NoALevels); + SetLength(BSS,NoBLevels); + SetLength(CSS,NoCLevels); + SetLength(ASumSqr,NoALevels); + SetLength(BSumSqr,NoBLevels); + SetLength(CSumSqr,NoCLevels); + SetLength(AMeans,NoALevels); + SetLength(BMeans,NoBLevels); + SetLength(CMeans,NoCLevels); + SetLength(ACount,NoALevels); + SetLength(BCount,NoBLevels); + SetLength(CCount,NoCLevels); + SetLength(ASDs,NoALevels); + SetLength(BSDs,NoBLevels); + SetLength(CSDs,NoCLevels); + SetLength(ACSS,NoALevels,NoCLevels); + SetLength(ACSumSqr,NoALevels,NoCLevels); + SetLength(ACCount,NoALevels,NoCLevels); + SetLength(ACMeans,NoALevels,NoCLevels); + SetLength(ACSDs,NoALevels,NoCLevels); + SetLength(ABSS,NoALevels,NoBLevels); + SetLength(ABSumSqr,NoALevels,NoBLevels); + SetLength(ABMeans,NoALevels,NoBLevels); + SetLength(ABCount,NoALevels,NoBLevels); + SetLength(ABSDs,NoALevels,NoBLevels); +end; + +procedure TABCNestedForm.GetSums; +VAR + Aindex, Bindex, Cindex, i, j, k: integer; + YValue: double; + strvalue: string; +begin + // clear memory + SSTot := 0.0; + SumSqrTot := 0.0; + for i := 0 to NoBLevels-1 do + begin + for j := 0 to NoALevels-1 do + begin + for k := 0 to NoCLevels-1 do + begin + SS[i,j,k] := 0.0; + SumSqr[i,j,k] := 0.0; + CellCount[i,j,k] := 0; + CellMeans[i,j,k] := 0.0; + end; + end; + end; + + for i := 0 to NoALevels-1 do + begin + ACount[i] := 0; + AMeans[i] := 0.0; + ASS[i] := 0.0; + ASumSqr[i] := 0.0; + end; + for j := 0 to NoBLevels-1 do + begin + BCount[j] := 0; + BMeans[j] := 0.0; + BSS[j] := 0.0; + BSumSqr[j] := 0.0; + end; + for k := 0 to NoCLevels-1 do + begin + CCount[k] := 0; + CMeans[k] := 0.0; + CSS[k] := 0.0; + CSumSqr[k] := 0.0; + end; + + for i := 0 to NoALevels-1 do + begin + for j := 0 to NoBLevels-1 do + begin + ABSS[i,j] := 0.0; + ABSumSqr[i,j] := 0.0; + ABCount[i,j] := 0; + ABSDs[i,j] := 0.0; + end; + end; + for i := 0 to NoALevels-1 do + begin + for k := 0 to NoCLevels-1 do + begin + ACSS[i,k] := 0.0; + ACSumSqr[i,k] := 0.0; + ACCount[i,k] := 0; + ACSDs[i,k] := 0.0; + end; + end; + + // accumulate sums and sums of squared values + for i := 1 to NoCases do + begin + strvalue := Trim(OS3MainFrm.DataGrid.Cells[ACol,i]); + Aindex := round(StrToFloat(strvalue)); + strvalue := Trim(OS3MainFrm.DataGrid.Cells[BCol,i]); + Bindex := round(StrToFloat(strvalue)); + strvalue := Trim(OS3MainFrm.DataGrid.Cells[CCol,i]); + Cindex := round(StrToFloat(strvalue)); + strvalue := Trim(OS3MainFrm.DataGrid.Cells[YCol,i]); + YValue := StrToFloat(strvalue); + Aindex := Aindex - MinA; + Bindex := Bindex - MinB; + Cindex := Cindex - MinC; + SS[Bindex,Aindex,Cindex] := SS[Bindex,Aindex,Cindex] + YValue * YValue; + SumSqr[Bindex,Aindex,Cindex] := SumSqr[Bindex,Aindex,Cindex] + YValue; + CellCount[Bindex,Aindex,Cindex] := CellCount[Bindex,Aindex,Cindex] + 1; + ACount[Aindex] := ACount[Aindex] + 1; + BCount[Bindex] := BCount[Bindex] + 1; + CCount[Cindex] := CCount[Cindex] + 1; + ASS[Aindex] := ASS[Aindex] + YValue * YValue; + BSS[Bindex] := BSS[Bindex] + YValue * YValue; + CSS[Cindex] := CSS[Cindex] + YValue * YValue; + ASumSqr[Aindex] := ASumSqr[Aindex] + YValue; + BSumSqr[Bindex] := BSumSqr[Bindex] + YValue; + CSumSqr[Cindex] := CSumSqr[Cindex] + YValue; + ACSS[Aindex,Cindex] := ACSS[Aindex,Cindex] + YValue * YValue; + ACSumSqr[Aindex,Cindex] := ACSumSqr[Aindex,Cindex] + YValue; + ACCount[Aindex,Cindex] := ACCount[Aindex,Cindex] + 1; + ABSS[Aindex,Bindex] := ABSS[Aindex,Bindex] + YValue * YValue; + ABSumSqr[Aindex,Bindex] := ABSumSqr[Aindex,Bindex] + YValue; + ABCount[Aindex,Bindex] := ABCount[Aindex,Bindex] + 1; + SSTot := SSTot + YValue * YValue; + SumSqrTot := SumSqrTot + YValue; + TotN := TotN + 1; + end; + + // get cell means and marginal means plus square of sums + for i := 0 to NoBLevels-1 do + begin + for j := 0 to NoALevels-1 do + begin + for k := 0 to NoCLevels-1 do + begin + if CellCount[i,j,k] > 0 then + begin + CellMeans[i,j,k] := SumSqr[i,j,k] / CellCount[i,j,k]; + SumSqr[i,j,k] := SumSqr[i,j,k] * SumSqr[i,j,k]; + CellSDs[i,j,k] := SS[i,j,k] - (SumSqr[i,j,k] / CellCount[i,j,k]); + CellSDs[i,j,k] := CellSDs[i,j,k] / (CellCount[i,j,k] - 1); + CellSDs[i,j,k] := sqrt(CellSDs[i,j,k]); + end; + end; + end; + end; + for i := 0 to NoBLevels-1 do + begin + if BCount[i] > 0 then + begin + BMeans[i] := BSumSqr[i] / BCount[i]; + BSumSqr[i] := BSumSqr[i] * BSumSqr[i]; + BSDs[i] := BSS[i] - (BSumSqr[i] / BCount[i]); + BSDs[i] := BSDs[i] / (BCount[i] - 1); + BSDs[i] := sqrt(BSDs[i]); + end; + end; + for i := 0 to NoALevels-1 do + begin + AMeans[i] := ASumSqr[i] / ACount[i]; + ASumSqr[i] := ASumSqr[i] * ASumSqr[i]; + ASDs[i] := ASS[i] - (ASumSqr[i] / ACount[i]); + ASDs[i] := ASDs[i] / (ACount[i] - 1); + ASDs[i] := Sqrt(ASDs[i]); + end; + for i := 0 to NoCLevels-1 do + begin + CMeans[i] := CSumSqr[i] / CCount[i]; + CSumSqr[i] := CSumSqr[i] * CSumSqr[i]; + CSDs[i] := CSS[i] - (CSumSqr[i] / CCount[i]); + CSDs[i] := CSDs[i] / (CCount[i] - 1); + CSDs[i] := sqrt(CSDs[i]); + end; + for i := 0 to NoALevels-1 do + begin + for k := 0 to NoCLevels-1 do + begin + ACMeans[i,k] := ACMeans[i,k] / ACCount[i,k]; + ACSumSqr[i,k] := ACSumSqr[i,k] * ACSumSqr[i,k]; + ACSDs[i,k] := ACSS[i,k] - (ACSumSqr[i,k] / ACCount[i,k]); + ACSDs[i,k] := ACSDs[i,k] / (ACCount[i,k] - 1); + ACSDs[i,k] := sqrt(ACSDs[i,k]); + end; + end; + for i := 0 to NoALevels-1 do + begin + for j := 0 to NoBLevels-1 do + begin + if ABCount[i,j] > 0 then + begin + ABMeans[i,j] := ABSumSqr[i,j] / ABCount[i,j]; + ABSumSqr[i,j] := ABSumSqr[i,j] * ABSumSqr[i,j]; + ABSDs[i,j] :=ABSS[i,j] - (ABSumSqr[i,j] / ABCount[i,j]); + ABSDs[i,j] := ABSDs[i,j] / (ABCount[i,j] - 1); + ABSDs[i,j] := sqrt(ABSDs[i,j]); + end; + end; + end; + TotMean := SumSqrTot / TotN; + SumSqrTot := SumSqrTot * SumSqrTot; +end; + +procedure TABCNestedForm.ShowMeans(AReport: TStrings); +var + i, j, k : integer; +begin + AReport.Add('Nested ANOVA by Bill Miller'); + AReport.Add('File Analyzed = %s', [OS3MainFrm.FileNameEdit.Text]); + AReport.Add(''); + + AReport.Add('CELL MEANS'); + AReport.Add('A LEVEL BLEVEL CLEVEL MEAN STD.DEV.'); + for i := 0 to NoALevels-1 do + for j := 0 to NoBLevels-1 do + for k := 0 to NoCLevels-1 do + if CellCount[j,i,k] > 0 then + AReport.Add('%5d %5d %5d %10.4f %10.4f', [i+MinA, j+MinB, k+MinC, CellMeans[j,i,k], CellSDs[j,i,k]]); + AReport.Add(''); + + AReport.Add('A MARGIN MEANS'); + AReport.Add('A LEVEL MEAN STD.DEV.'); + for i := 0 to NoALevels-1 do + AReport.Add('%5d %10.3f %10.3f', [i+MinA, AMeans[i], ASDs[i]]); + AReport.Add(''); + + AReport.Add('B MARGIN MEANS'); + AReport.Add('B LEVEL MEAN STD.DEV.'); + for i := 0 to NoBLevels-1 do + if BCount[i] > 0 then + AReport.Add('%5d %10.3f %10.3f', [i+MinB, BMeans[i], BSDs[i]]); + AReport.Add(''); + + AReport.Add('C MARGIN MEANS'); + AReport.Add('C LEVEL MEAN STD.DEV.'); + for i := 0 to NoCLevels-1 do + if CCount[i] > 0 then + AReport.Add('%5d %10.3f %10.3f', [i+MinC, CMeans[i], CSDs[i]]); + + AReport.Add(''); + AReport.Add('AB MARGIN MEANS'); + AReport.Add('A LEVEL B LEVEL MEAN STD.DEV.'); + for i := 0 to NoALevels-1 do + for j := 0 to NoBLevels-1 do + if ABCount[i,j] > 0 then + AReport.Add('%5d %5D %10.3f %10.3f', [i+MinA, j+MinB, ABMeans[i,j], ABSDs[i,j]]); + AReport.Add(''); + + AReport.Add('AC MARGIN MEANS'); + AReport.Add('A LEVEL C LEVEL MEAN STD.DEV.'); + for i := 0 to NoALevels-1 do + for j := 0 to NoCLevels-1 do + if ACCount[i,j] > 0 then + AReport.Add('%5d %5D %10.3f %10.3f',[i+MinA, j+MinC, ACMeans[i,j], ACSDs[i,j]]); + AReport.Add(''); + + AReport.Add('GRAND MEAN = %10.3f', [TotMean]); + AReport.Add(''); +// OutputFrm.ShowModal; +end; + +procedure TABCNestedForm.GetResults; +VAR + temp, temp2, temp3, temp4, constant : double; + NoBLevelsInA, BLevCount, i, j, k, celln : integer; +begin + celln := 0; + for i := 0 to NoALevels-1 do + begin + for j := 0 to NoBLevels-1 do + begin + for k := 0 to NoCLevels-1 do + begin + if CellCount[j,i,k] > celln then celln := CellCount[j,i,k]; + end; + end; + end; + // assume all cells have same n size + // get no. of levels in A + BLevCount := 0; + for i := 0 to NoALevels-1 do + begin + NoBLevelsInA := 0; + for j := 0 to NoBLevels-1 do + begin + if CellCount[j,i,0] > 0 then NoBLevelsInA := NoBLevelsInA + 1; + end; + if NoBLevelsInA > BLevCount then BLevCount := NoBLevelsInA; + end; + dfA := NoALevels - 1; + dfBwA := NoALevels * (BLevCount - 1); + dfC := NoCLevels - 1; + dfAC := (NoALevels-1) * (NoCLevels-1); + dfBwAC := NoALevels * (BLevCount-1) * (NoCLevels -1); + dfwcell := NoALevels * BLevCount * NoCLevels * (celln - 1); + dftotal := TotN - 1; + + constant := SumSqrTot / TotN; + SSTot := SSTot - constant; + MSTot := SSTot / dftotal; + + // get A Effects + SSA := 0.0; + for i := 0 to NoALevels-1 do SSA := SSA + (ASumSqr[i] / ACount[i]); + temp := SSA; + SSA := SSA - constant; + MSA := SSA / dfA; + + //Get C Effects + SSC := 0.0; + for i := 0 to NoCLevels-1 do SSC := SSC + (CSumSqr[i] / CCount[i]); + temp2 := SSC; + SSC := SSC - constant; + MSC := SSC / dfC; + + // get B within A + SSB := 0.0; + for i := 0 to NoALevels - 1 do + begin + for j := 0 to NoBLevels-1 do + begin + if ABCount[i,j] > 0 then SSB := SSB + (ABSumSqr[i,j] / ABCount[i,j]); + end; + end; + temp3 := SSB; + SSB := SSB - temp; + MSB := SSB / dfBwA; + + // get AC interaction + SSAC := 0.0; + for i := 0 to NoALevels-1 do + begin + for j := 0 to NoCLevels-1 do SSAC := SSAC + ACSumSqr[i,j] / ACCount[i,j] + end; + temp4 := SSAC; + SSAC := SSAC - temp - temp2 + constant; + MSAC := SSAC / dfAC; + + // get B within A x C interaction + SSBwAC := 0.0; + for i := 0 to NoALevels-1 do + begin + for j := 0 to NoBLevels-1 do + begin + for k := 0 to NoCLevels-1 do + begin + if CellCount[j,i,k] > 0 then SSBwAC := SSBwAC + + (SumSqr[j,i,k] / CellCount[j,i,k]); + end; + end; + end; + SSBwAC := SSBwAC - temp3 - temp4 + temp; + MSBwAC := SSBwAC / dfBwAC; + + SSW := SSTot - SSA - SSB - SSAB - SSAC - SSBwAC; + MSW := SSW / dfwcell; +end; + +procedure TABCNestedForm.ShowResults(AReport: TStrings); +VAR + F, PF : double; +begin + AReport.Add(''); + AReport.Add('ANOVA TABLE'); + AReport.Add('SOURCE D.F. SS MS F PROB.'); + + F := MSA / MSW; + PF := probf(F,dfA,dfwcell); + AReport.Add('A %4D %10.3f%10.3f%10.3f%10.3f', [dfA, SSA, MSA, F, PF]); + + F := MSB / MSW; + PF := probf(F,dfBwA,dfwcell); + AReport.Add('B(A) %4D %10.3f%10.3f%10.3f%10.3f', [dfBwA, SSB, MSB, F, PF]); + + F := MSC / MSW; + PF := probf(F,dfC,dfwcell); + AReport.Add('C %4D %10.3f%10.3f%10.3f%10.3f', [dfC, SSC, MSC, F, PF]); + + F := MSAC / MSW; + PF := probf(F,dfAC,dfwcell); + AReport.Add('AxC %4D %10.3f%10.3f%10.3f%10.3f', [dfAC, SSAC, MSAC, F, PF]); + + F := MSBwAC / MSW; + PF := probf(F,dfBwAC,dfwcell); + AReport.Add('B(A)xC %4D %10.3f%10.3f%10.3f%10.3f', [dfBwAC, SSBwAC, MSBwAC, F, PF]); + + AReport.Add('w.cells %4D %10.3f%10.3f', [dfwcell, SSW, MSW]); + AReport.Add('Total %4D %10.3f', [dftotal, SSTot]); + + DisplayReport(AReport); +end; + +procedure TABCNestedForm.ReleaseMemory; +begin + ColNoSelected := nil; + ABSDs := nil; + ABCount := nil; + ABMeans := nil; + ABSumSqr := nil; + ABSS := nil; + ACSDs := nil; + ACMeans := nil; + ACCount := nil; + ACSumSqr := nil; + ACSS := nil; + CSDs := nil; + BSDs := nil; + ASDs := nil; + CCount := nil; + BCount := nil; + ACount := nil; + CMeans := nil; + BMeans := nil; + AMeans := nil; + CSumSqr := nil; + BSumSqr := nil; + ASumSqr := nil; + CSS := nil; + BSS := nil; + ASS := nil; + CellSDs := nil; + CellMeans := nil; + CellCount := nil; + SumSqr := nil; + SS := nil; +end; + +procedure TABCNestedForm.TwoWayPlot; +VAR + plottype, i, j, k : integer; + maxmean, XBar : double; + title, setstring : string; + XValue : DblDyneVec; +begin + case OptionsBox.ItemIndex of + 0: plottype := 9; + 1: plottype := 10; + 2: plottype := 1; + 3: plottype := 2; + end; + + // Factor A first + maxmean := -1000.0; + SetLength(XValue,NoALevels); + setstring := 'FACTOR A'; + GraphFrm.SetLabels[1] := setstring; + SetLength(GraphFrm.Xpoints,1,NoALevels); + SetLength(GraphFrm.Ypoints,1,NoALevels); + for i := 1 to NoALevels do + begin + GraphFrm.Ypoints[0,i-1] := AMeans[i-1]; + if AMeans[i-1] > maxmean then maxmean := AMeans[i-1]; + XValue[i-1] := MinA + i -1; + GraphFrm.Xpoints[0,i-1] := XValue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NoALevels; + GraphFrm.Heading := FactorA; + title := FactorA + ' Group Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + XValue := nil; + + // Factor B next + SetLength(XValue,NoBLevels); + setstring := 'FACTOR B'; + GraphFrm.SetLabels[1] := setstring; + maxmean := -1000.0; + SetLength(GraphFrm.Xpoints,1,NoBLevels); + SetLength(GraphFrm.Ypoints,1,NoBLevels); + for i := 1 to NoBLevels do + begin + GraphFrm.Ypoints[0,i-1] := BMeans[i-1]; + if BMeans[i-1] > maxmean then maxmean := BMeans[i-1]; + XValue[i-1] := MinB + i - 1; + GraphFrm.Xpoints[0,i-1] := XValue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NoBLevels; + GraphFrm.Heading := 'FACTOR B'; + title := FactorB + ' Group Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + XValue := nil; + + // Factor C next + SetLength(XValue,NoCLevels); + setstring := 'FACTOR C'; + GraphFrm.SetLabels[1] := setstring; + maxmean := -1000.0; + SetLength(GraphFrm.Xpoints,1,NoCLevels); + SetLength(GraphFrm.Ypoints,1,NoCLevels); + for i := 0 to NoCLevels-1 do + begin + GraphFrm.Ypoints[0,i] := CMeans[i]; + if CMeans[i] > maxmean then maxmean := CMeans[i]; + XValue[i] := MinC + i - 1; + GraphFrm.Xpoints[0,i] := XValue[i]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NoCLevels; + GraphFrm.Heading := 'FACTOR C'; + title := FactorB + ' Group Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + XValue := nil; + + // Factor A x B interaction within each slice next + SetLength(XValue,NoALevels + NoBLevels); + SetLength(GraphFrm.Ypoints,NoALevels,NoBLevels); + SetLength(GraphFrm.Xpoints,1,NoBLevels); + for k := 0 to NoCLevels-1 do + begin + maxmean := -1000.0; + for i := 0 to NoALevels-1 do + begin + setstring := 'FACTOR A ' + IntToStr(i+1); + GraphFrm.SetLabels[i+1] := setstring; + for j := 0 to NoBLevels-1 do + begin + if ABCount[i,j] > 0 then + begin + if ABMeans[i,j] > maxmean then maxmean := ABMeans[i,j]; + GraphFrm.Ypoints[i,j] := ABMeans[i,j]; + end; + end; + end; + for j := 0 to NoBLevels-1 do + begin + XValue[j] := MinB + j - 1; + GraphFrm.Xpoints[0,j] := XValue[j]; + end; + GraphFrm.nosets := NoALevels; + GraphFrm.nbars := NoBLevels; + GraphFrm.Heading := 'FACTOR A x Factor B within C' + IntToStr(k+1); + title := FactorB + ' Group Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + XValue := nil; + + //Factor A x C Interaction within each column next + setLength(XValue,NoALevels+NoCLevels); + SetLength(GraphFrm.Xpoints,1,NoCLevels); + SetLength(GraphFrm.Ypoints,NoALevels,NoCLevels); + for j := 0 to NoBLevels-1 do + begin + maxmean := 0.0; + for i := 0 to NoALevels-1 do + begin + setstring := 'Factor A ' + IntToStr(i+1); + GraphFrm.SetLabels[i+1] := setstring; + for k := 0 to NoCLevels-1 do + begin + XBar := ACMeans[i,k]; + if XBar > maxmean then maxmean := XBar; + GraphFrm.Ypoints[i,k] := XBar; + end; + end; + for k := 0 to NoCLevels-1 do + begin + XValue[k] := MinC + k - 1; + GraphFrm.Xpoints[0,k] := XValue[k]; + end; + GraphFrm.nosets := NoALevels; + GraphFrm.nbars := NoCLevels; + GraphFrm.Heading := 'FACTOR A x Factor C within B ' + IntToStr(j+1); + title := FactorC + ' Group Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; +// GraphFrm.ShowModal; + end; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + XValue := nil; + end; + +procedure TABCNestedForm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TABCNestedForm.UpdateBtnStates; +begin + AInBtn.Enabled := (VarList.ItemIndex > -1) and (FactorAEdit.Text = ''); + BInBtn.Enabled := (VarList.ItemIndex > -1) and (FactorBEdit.Text = ''); + CInBtn.Enabled := (VarList.ItemIndex > -1) and (FactorCEdit.Text = ''); + DepInBtn.Enabled := (VarList.ItemIndex > -1) and (DepEdit.Text = ''); + AOutBtn.Enabled := (FactorAEdit.Text <> ''); + BOutBtn.Enabled := (FactorBEdit.Text <> ''); + COutBtn.Enabled := (FactorCEdit.Text <> ''); + DepOutBtn.Enabled := (DepEdit.Text <> ''); +end; + +initialization + {$I abcnestedunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/abranovaunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/abranovaunit.lfm new file mode 100644 index 000000000..4afd687af --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/abranovaunit.lfm @@ -0,0 +1,380 @@ +object ABRAnovaFrm: TABRAnovaFrm + Left = 577 + Height = 405 + Top = 337 + Width = 481 + AutoSize = True + Caption = 'AxBxR ANOVA (two between and repeated measures)' + ClientHeight = 405 + ClientWidth = 481 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 51 + Top = 305 + Width = 324 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Options:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 24 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 31 + ClientWidth = 320 + TabOrder = 1 + object PlotChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 79 + Caption = 'Plot Means' + TabOrder = 0 + end + object TestChk: TCheckBox + Left = 115 + Height = 19 + Top = 6 + Width = 193 + Caption = 'Test Homogeneity of Covariance' + TabOrder = 1 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 268 + Height = 25 + Top = 372 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 330 + Height = 25 + Top = 372 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 414 + Height = 25 + Top = 372 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 5 + end + object HelpBtn: TButton + Tag = 102 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 209 + Height = 25 + Top = 372 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 2 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 356 + Width = 481 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 289 + Top = 8 + Width = 465 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 289 + ClientWidth = 465 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 100 + Caption = 'Available Variables:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = ACodes + Left = 254 + Height = 15 + Top = 25 + Width = 88 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor A Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = BCodes + Left = 254 + Height = 15 + Top = 109 + Width = 87 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor B Variable' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CInBtn + Left = 254 + Height = 15 + Top = 185 + Width = 102 + BorderSpacing.Left = 8 + Caption = 'Repeated Measures' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AInBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 272 + Top = 17 + Width = 210 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = CListSelectionChange + TabOrder = 0 + end + object AInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 218 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = AInBtnClick + Spacing = 0 + TabOrder = 1 + end + object AOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = AInBtn + AnchorSideTop.Side = asrBottom + Left = 218 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = AOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object BInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = AOutBtn + AnchorSideTop.Side = asrBottom + Left = 218 + Height = 28 + Top = 101 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = BInBtnClick + Spacing = 0 + TabOrder = 4 + end + object BOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = BInBtn + AnchorSideTop.Side = asrBottom + Left = 218 + Height = 28 + Top = 133 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = BOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object CInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = BOutBtn + AnchorSideTop.Side = asrBottom + Left = 218 + Height = 28 + Top = 185 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = CInBtnClick + Spacing = 0 + TabOrder = 7 + end + object COutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = CInBtn + AnchorSideTop.Side = asrBottom + Left = 218 + Height = 28 + Top = 217 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = COutBtnClick + Spacing = 0 + TabOrder = 8 + end + object ACodes: TEdit + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = AOutBtn + AnchorSideBottom.Side = asrBottom + Left = 254 + Height = 23 + Top = 42 + Width = 211 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + OnChange = ACodesChange + ReadOnly = True + TabOrder = 3 + Text = 'ACodes' + end + object BCodes: TEdit + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = BOutBtn + AnchorSideBottom.Side = asrBottom + Left = 254 + Height = 23 + Top = 126 + Width = 211 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + OnChange = ACodesChange + ReadOnly = True + TabOrder = 6 + Text = 'BCodes' + end + object CList: TListBox + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 254 + Height = 85 + Top = 202 + Width = 211 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = CListSelectionChange + TabOrder = 9 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/abranovaunit.pas b/applications/lazstats/source/forms/analysis/comparisons/abranovaunit.pas new file mode 100644 index 000000000..c77a7cb7b --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/abranovaunit.pas @@ -0,0 +1,1029 @@ +// Use file "abranova.laz" for testing. + +unit ABRANOVAUnit; + +{$mode objfpc}{$H+} + +interface + +uses + contexthelpunit, Classes, SysUtils, FileUtil, LResources, Forms, Controls, + Graphics, Dialogs, StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, GraphLib, Globals, DataProcs, MatrixLib; + +type + + { TABRAnovaFrm } + + TABRAnovaFrm = class(TForm) + AInBtn: TBitBtn; + AOutBtn: TBitBtn; + Bevel1: TBevel; + BInBtn: TBitBtn; + BOutBtn: TBitBtn; + CInBtn: TBitBtn; + COutBtn: TBitBtn; + ACodes: TEdit; + BCodes: TEdit; + HelpBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + TestChk: TCheckBox; + PlotChk: TCheckBox; + GroupBox1: TGroupBox; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + CList: TListBox; + VarList: TListBox; + procedure ACodesChange(Sender: TObject); + procedure AInBtnClick(Sender: TObject); + procedure AOutBtnClick(Sender: TObject); + procedure BInBtnClick(Sender: TObject); + procedure BOutBtnClick(Sender: TObject); + procedure CInBtnClick(Sender: TObject); + procedure CListSelectionChange(Sender: TObject; User: boolean); + procedure ComputeBtnClick(Sender: TObject); + procedure COutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + ColNoSelected: IntDyneVec; + ACol, BCol, NoSelected, MinA, MaxA, MinB, MaxB, NoAGrps, NoBGrps : integer; + group, MaxRows, MaxCols, TotalN, NinGrp : integer; + SubjTot, GrandTotal, SumXSqr : double; + DFA, DFB, DFC, DFAB, DFAC, DFBC, DFABC, DFBetween : double; + DFerrorBetween, DFWithin, DFerrorWithin : double; + SSA, SSB, SSC, SSAB, SSAC, SSBC, SSABC, SSBetweenSubjects : double; + SSerrorBetween, SSWithinSubjects, SSerrorWithin : double; + MSA, MSB, MSC, MSAB, MSAC, MSBC, MSABC, MSerrorBetween, MSerrorWithin : double; + FA, FB, FC, FAB, FAC, FBC, FABC : double; + ProbA, ProbB, ProbC, ProbAB, ProbAC, ProbBC, ProbABC : double; + Acnt, Bcnt, Ccnt : IntDyneVec; + ASums, BSums, CSums, SumPSqr : DblDyneVec; + ABSums, ACSums, BCSums, AMatrix, PooledMat : DblDyneMat; + ABCSums : DblDyneCube; + ABCNcnt : IntDyneCube; + RowLabels, ColLabels : StrDyneVec; + selected : integer; + + function InitData: Boolean; + procedure GetData; + procedure Calculate; + procedure Summarize(AReport: TStrings); + procedure MeansReport(AReport: TStrings); + procedure BoxTests(AReport: TStrings); + procedure GraphMeans; + procedure CleanUp; + procedure UpdateBtnStates; + + public + { public declarations } + end; + +var + ABRAnovaFrm: TABRAnovaFrm; + +implementation + +uses + Math; + +{ TABRAnovaFrm } + +procedure TABRAnovaFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Items.Clear; + CList.Items.Clear; + ACodes.Text := ''; + BCodes.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + PlotChk.Checked := false; + TestChk.Checked := false; + UpdateBtnStates; +end; + +procedure TABRAnovaFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinHeight := Height; + Constraints.MinWidth := Width; + + FAutoSized := true; +end; + +procedure TABRAnovaFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TABRAnovaFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TABRAnovaFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TABRAnovaFrm.ACodesChange(Sender: TObject); +begin + UpdateBtnStates; +end; + +procedure TABRAnovaFrm.AInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (ACodes.Text = '') then + begin + ACodes.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TABRAnovaFrm.AOutBtnClick(Sender: TObject); +begin + if ACodes.Text <> '' then + begin + VarList.Items.Add(ACodes.Text); + ACodes.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TABRAnovaFrm.BInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (BCodes.Text = '') then + begin + BCodes.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TABRAnovaFrm.BOutBtnClick(Sender: TObject); +begin + if BCodes.Text <> '' then + begin + VarList.Items.Add(BCodes.Text); + BCodes.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TABRAnovaFrm.CInBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + CList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TABRAnovaFrm.ComputeBtnClick(Sender: TObject); +var + lReport: TStrings; +begin + lReport := TStringList.Create; + try + if InitData then + begin + GetData; + Calculate; + Summarize(lReport); + MeansReport(lReport); + if TestChk.Checked then BoxTests(lReport); + DisplayReport(lReport); + if PlotChk.Checked then GraphMeans; + end; + finally + lReport.Free; + CleanUp; + end; +end; + +procedure TABRAnovaFrm.COutBtnClick(Sender: TObject); +var + i: Integer; +begin + i := 0; + while i < CList.Items.Count do + begin + if CList.Selected[i] then + begin + VarList.Items.Add(CList.Items[i]); + CList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + VarList.ItemIndex := -1; + CList.ItemIndex := -1; + UpdateBtnStates; +end; + +function TABRAnovaFrm.InitData: Boolean; +var + cellstring: string; + i, j, k: integer; +begin + Result := false; + + SetLength(ColNoSelected,NoVariables); + ACol := 0; + BCol := 0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = ACodes.Text) then ACol := i; + if (cellstring = BCodes.Text) then BCol := i; + end; + if ( (ACol = 0) or (BCol = 0)) then + begin + MessageDlg('Select a variable for the A and B Variable Codes.', mtError, [mbOK], 0); + exit; + end; + + NoSelected := CList.Items.Count; + MinA := 10000; + MaxA := -10000; + MinB := 10000; + MaxB := -10000; + for i := 1 to NoCases do + begin + if not ValidValue(i,ACol) then continue; + cellstring := Trim(OS3MainFrm.DataGrid.Cells[ACol,i]); + group := round(StrToFloat(cellstring)); + if (group > MaxA) then MaxA := group; + if (group < MinA) then MinA := group; + + cellstring := Trim(OS3MainFrm.DataGrid.Cells[BCol,i]); + if not ValidValue(i,BCol) then continue; + group := round(StrToFLoat(cellstring)); + if (group > MaxB) then MaxB := group; + if (group < MinB) then MinB := group; + end; + NoAGrps := MaxA - MinA + 1; + NoBGrps := MaxB - MinB + 1; + MaxRows := NoAGrps * NoBGrps; + MaxCols := NoSelected; + if (NoBGrps > NoSelected) then MaxCols := NoBGrps; + if (MaxCols > MaxRows) then MaxRows := MaxCols; + + // allocate storage for arrays + SetLength(ASums,NoAGrps); + SetLength(Bsums,NoBGrps); + SetLength(Csums,NoCases); + SetLength(ABSums,NoAGrps,NoBGrps); + SetLength(ACSums,NoAGrps,NoSelected); + SetLength(BCSums,NoBGrps,NoSelected); + SetLength(AMatrix,MaxRows,MaxRows); + SetLength(SumPSqr,NoCases); + SetLength(Acnt,NoAGrps); + SetLength(Bcnt,NoBGrps); + SetLength(Ccnt,MaxRows); + SetLength(RowLabels,NoSelected); + SetLength(ColLabels,NoSelected); + SetLength(ABCSums,NoAGrps,NoBGrps,NoSelected); + SetLength(ABCNcnt,NoAGrps,NoBGrps,NoSelected); + + // initialize arrays + for i := 0 to NoAGrps-1 do + begin + ASums[i] := 0.0; + Acnt[i] := 0; + for j := 0 to NoBGrps-1 do + begin + ABSums[i,j] := 0.0; + for k := 0 to NoSelected-1 do + begin + ABCSums[i,j,k] := 0.0; + ABCNcnt[i,j,k] := 0; + end; + end; + for j := 0 to NoSelected-1 do + begin + ACSums[i,j] := 0.0; + end; + end; + for i := 0 to NoBGrps-1 do + begin + BSums[i] := 0.0; + Bcnt[i] := 0; + for j := 0 to NoSelected-1 do + begin + BCSums[i,j] := 0.0; + end; + end; + for i := 0 to NoSelected-1 do + begin + CSums[i] := 0.0; + Ccnt[i] := 0; + end; + for i := 0 to NoCases-1 do SumPSqr[i] := 0.0; + GrandTotal := 0.0; + TotalN := 0; + SumXSqr := 0.0; + + Result := true; +end; + +procedure TABRAnovaFrm.GetData; +var + i, j, SubjA, SubjB: integer; + cellstring: string; + X: double; +begin + for i := 0 to NoSelected - 1 do + begin + cellstring := CList.Items.Strings[i]; + for j := 1 to NoVariables do + if (OS3MainFrm.DataGrid.Cells[j,0] = cellstring) then ColNoSelected[i] := j; + end; + + ColNoSelected[NoSelected] := ACol; + ColNoSelected[NoSelected+1] := BCol; + selected := NoSelected + 2; + + // read data and store sums + for i := 1 to NoCases do + begin + if not GoodRecord(i,selected,ColNoSelected) then continue; + SubjA := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ACol,i]))); + SubjA := SubjA - MinA + 1; + SubjB := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[BCol,i]))); + SubjB := SubjB - MinB + 1; + SubjTot := 0.0; + for j := 1 to NoSelected do + begin + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNoSelected[j-1],i])); + SubjTot := SubjTot + X; + SumXSqr := SumXSqr + (X * X); + ABCSums[SubjA-1,SubjB-1,j-1] := ABCSums[SubjA-1,SubjB-1,j-1] + X; + ABCNcnt[SubjA-1,SubjB-1,j-1] := ABCNcnt[SubjA-1,SubjB-1,j-1] + 1; + Acnt[SubjA-1] := Acnt[SubjA-1] + 1; + Bcnt[SubjB-1] := Bcnt[SubjB-1] + 1; + Ccnt[j-1] := Ccnt[j-1] + 1; + TotalN := TotalN + 1; + end; + SumPSqr[i-1] := SumPSqr[i-1] + (SubjTot * SubjTot); + GrandTotal := GrandTotal + SubjTot; + NinGrp := ABCNcnt[0,0,0]; + end; +end; + +procedure TABRAnovaFrm.Calculate; +var + SumA, SumB, SumC, SumAB, SumAC, SumBC, SumABC : double; + Term1, Term2, Term3, Term4, Term5, Term6, Term7, Term8, Term9, Term10 : double; + i, j, k, CountA, CountB, CountC: integer; +begin + Term1 := (GrandTotal * GrandTotal) / TotalN; + Term2 := SumXSqr; + Term3 := 0.0; + countA := 0; + for i := 1 to NoAGrps do + begin + SumA := 0.0; + countA := countA + Acnt[i-1]; + for j := 1 to NoBGrps do + for k := 1 to NoSelected do SumA := SumA + ABCSums[i-1,j-1,k-1]; + ASums[i-1] := ASums[i-1] + SumA; + Term3 := Term3 + (SumA * SumA); + end; + Term3 := Term3 / (NinGrp * NoBGrps * NoSelected); + + Term4 := 0; + countB := 0; + for j := 1 to NoBGrps do + begin + SumB := 0.0; + CountB := CountB + Bcnt[j-1]; + for i := 1 to NoAGrps do + for k := 1 to NoSelected do SumB := SumB + ABCSums[i-1,j-1,k-1]; + BSums[j-1] := BSums[j-1] + SumB; + Term4 := Term4 + (SumB * SumB); + end; + Term4 := Term4 / (NinGrp * NoAGrps * NoSelected); + + Term5 := 0.0; + countC := 0; + for k := 1 to NoSelected do + begin + SumC := 0.0; + CountC := CountC + Ccnt[k-1]; + for i := 1 to NoAGrps do + for j := 1 to NoBGrps do SumC := SumC + ABCSums[i-1,j-1,k-1]; + CSums[k-1] := CSums[k-1] + SumC; + Term5 := Term5 + (SumC * SumC); + end; + Term5 := Term5 / (NinGrp * NoAGrps * NoBGrps); + + + Term6 := 0.0; + for i := 1 to NoAGrps do + begin + for j := 1 to NoBGrps do + begin + SumAB := 0.0; + //CountAB := CountAB + ABcnt^[i,j]; + for k := 1 to NoSelected do SumAB := SumAB + ABCSums[i-1,j-1,k-1]; + ABSums[i-1,j-1] := ABSums[i-1,j-1] + SumAB; + Term6 := Term6 + (SumAB * SumAB); + end; + end; + Term6 := Term6 / (NinGrp * NoSelected); + + Term7 := 0.0; + for i := 1 to NoAGrps do + begin + for k := 1 to NoSelected do + begin + SumAC := 0.0; + for j := 1 to NoBGrps do SumAC := SumAC + ABCSums[i-1,j-1,k-1]; + ACSums[i-1,k-1] := ACSums[i-1,k-1] + SumAC; + Term7 := Term7 + (SumAC * SumAC); + end; + end; + Term7 := Term7 / (NinGrp * NoBGrps); + + Term8 := 0.0; + for j := 1 to NoBGrps do + begin + for k := 1 to NoSelected do + begin + SumBC := 0.0; + for i := 1 to NoAGrps do SumBC := SumBC + ABCSums[i-1,j-1,k-1]; + BCSums[j-1,k-1] := BCSums[j-1,k-1] + SumBC; + Term8 := Term8 + (SumBC * SumBC); + end; + end; + Term8 := Term8 / (NinGrp * NoAGrps); + + Term9 := 0.0; + for i := 1 to NoAGrps do + begin + for j := 1 to NoBGrps do + begin + for k := 1 to NoSelected do + begin + SumABC := ABCSums[i-1,j-1,k-1]; + //CountABC := CountABC + ABCNcnt[i,j,k]; + Term9 := Term9 + (SumABC * SumABC); + end; + end; + end; + Term9 := Term9 / NinGrp; + + Term10 := 0.0; + for i := 1 to NoCases do Term10 := Term10 + SumPSqr[i-1]; + Term10 := Term10 / NoSelected; + + //Get DF, SS, MS, F and Probabilities + DFBetween := (NinGrp * NoAGrps * NoBGrps) - 1.0; + DFA := NoAGrps - 1.0; + DFB := NoBGrps - 1.0; + DFAB := (NoAGrps - 1.0) * (NoBGrps - 1.0); + DFerrorBetween := (NoAGrps * NoBGrps) * (NinGrp - 1.0); + DFWithin := (NinGrp * NoAGrps * NoBGrps) * (NoSelected - 1.0); + DFC := NoSelected - 1.0; + DFAC := (NoAGrps - 1.0) * (NoSelected - 1.0); + DFBC := (NoBGrps - 1.0) * (NoSelected - 1.0); + DFABC := (NoAGrps - 1.0) * (NoBGrps - 1.0) * (NoSelected - 1.0); + DFerrorWithin := NoAGrps * NoBGrps * (NinGrp - 1.0) * (NoSelected - 1.0); + SSBetweenSubjects := Term10 - Term1; + SSA := Term3 - Term1; + SSB := Term4 - Term1; + SSAB := Term6 - Term3 - Term4 + Term1; + SSerrorBetween := Term10 - Term6; + SSWithinSubjects := Term2 - Term10; + SSC := Term5 - Term1; + SSAC := Term7 - Term3 - Term5 + Term1; + SSBC := Term8 - Term4 - Term5 + Term1; + SSABC := Term9 - Term6 - Term7 - Term8 + Term3 + Term4 + Term5 - Term1; + SSerrorWithin := Term2 - Term9 - Term10 + Term6; + MSA := SSA / DFA; + MSB := SSB / DFB; + MSAB := SSAB / DFAB; + MSerrorBetween := SSerrorBetween / DFerrorBetween; + MSC := SSC / DFC; + MSAC := SSAC / DFAC; + MSBC := SSBC / DFBC; + MSABC := SSABC / DFABC; + MSerrorWithin := SSerrorWithin / DFerrorWithin; + FA := MSA / MSerrorBetween; + FB := MSB / MSerrorBetween; + FAB := MSAB / MSerrorBetween; + FC := MSC / MSerrorWithin; + FAC := MSAC / MSerrorWithin; + FBC := MSBC / MSerrorWithin; + FABC := MSABC / MSerrorWithin; + ProbA := probf(FA,DFA,DFerrorBetween); + ProbB := probf(FB,DFB,DFerrorBetween); + ProbAB := probf(FAB,DFAB,DFerrorBetween); + ProbC := probf(FC,DFC,DFerrorWithin); + ProbAC := probf(FAC,DFAC,DFerrorWithin); + ProbBC := probf(FBC,DFBC,DFerrorWithin); + ProbABC := probf(FABC,DFABC,DFerrorWithin); +end; + +procedure TABRAnovaFrm.Summarize(AReport: TStrings); +begin + AReport.Add('SOURCE DF SS MS F PROB.'); + AReport.Add(''); + AReport.Add('Between Subjects %5.0f%10.3f',[DFBetween,SSBetweenSubjects]); + AReport.Add(' A Effects %5.0f%10.3f%10.3f%10.3f%10.3f', [DFA, SSA, MSA, FA, ProbA]); + AReport.Add(' B Effects %5.0f%10.3f%10.3f%10.3f%10.3f', [DFB, SSB, MSB, FB, ProbB]); + AReport.Add(' AB Effects %5.0f%10.3f%10.3f%10.3f%10.3f', [DFAB, SSAB, MSAB, FAB, ProbAB]); + AReport.Add(' Error Between %5.0f%10.3f%10.3f', [DFerrorBetween,SSerrorBetween,MSerrorBetween]); + AReport.Add(''); + AReport.Add('Within Subjects %5.0f%10.3f', [DFWithin,SSWithinSubjects]); + AReport.Add(' C Replications %5.0f%10.3f%10.3f%10.3f%10.3f', [DFC, SSC, MSC, FC, ProbC]); + AReport.Add(' AC Effects %5.0f%10.3f%10.3f%10.3f%10.3f', [DFAC, SSAC, MSAC, FAC, ProbAC]); + AReport.Add(' BC Effects %5.0f%10.3f%10.3f%10.3f%10.3f', [DFBC, SSBC, MSBC, FBC, ProbBC]); + AReport.Add(' ABC Effects %5.0f%10.3f%10.3f%10.3f%10.3f', [DFABC, SSABC, MSABC, FABC, ProbABC]); + AReport.Add(' Error Within %5.0f%10.3f%10.3f', [DFerrorWithin, SSerrorWithin, MSerrorWithin]); + AReport.Add(''); + AReport.Add('Total %5.0f%10.3f', [DFBetween + DFWithin, SSBetweenSubjects + SSWithinSubjects]); + AReport.Add(''); +// OutputFrm.ShowModal; +end; + +procedure TABRAnovaFrm.MeansReport(AReport: TStrings); +var + ColHeader, LabelStr: string; + Title: string; + i, j, k, row: integer; +begin + row := 1; + //OutputFrm.Clear; + Title := 'ABR Means Table'; + ColHeader := 'Repeated Measures'; + for i := 1 to NoAGrps do + begin + for j := 1 to NoBGrps do + begin + LabelStr := format('A%d B%d',[i,j]); + RowLabels[row-1] := LabelStr; + for k := 1 to NoSelected do + begin + AMatrix[row-1,k-1] := ABCSums[i-1,j-1,k-1] / NinGrp; + ColLabels[k-1] := OS3MainFrm.DataGrid.Cells[ColNoSelected[k-1],0]; + end; + inc(row); + end; + end; + MatPrint(AMatrix,MaxRows,NoSelected,Title,RowLabels,ColLabels,NinGrp, AReport); + + Title := 'AB Means Table'; + ColHeader := 'B Levels'; + for i := 1 to NoAGrps do + begin + LabelStr := format('A%d',[i]); + RowLabels[i-1] := LabelStr; + for j := 1 to NoBGrps do + AMatrix[i-1,j-1] := ABSums[i-1,j-1] / (NinGrp * NoSelected); + end; + for j := 1 to NoBGrps do + begin + LabelStr := format('B %d',[j]); + ColLabels[j-1] := LabelStr; + end; + MatPrint(AMatrix,NoAgrps,NoBgrps,Title,RowLabels,ColLabels,NinGrp*NoSelected, AReport); + + Title := 'AC Means Table'; + ColHeader := 'C Levels'; + for i := 1 to NoAGrps do + begin + LabelStr := format('A%d',[i-1]); + RowLabels[i-1] := LabelStr; + for j := 1 to NoSelected do + AMatrix[i-1,j-1] := ACSums[i-1,j-1] / (NinGrp * NoBGrps); + end; + for j := 1 to NoSelected do + begin + LabelStr := format('C%d',[j-1]); + ColLabels[j-1] := LabelStr; + end; + MatPrint(AMatrix,NoAGrps,NoSelected,Title,RowLabels,ColLabels,NinGrp*NoBGrps, AReport); + + Title := 'BC Means Table'; + ColHeader := 'C Levels'; + for i := 1 to NoBGrps do + begin + LabelStr := format('B%d',[i]); + RowLabels[i-1] := LabelStr; + for j := 1 to NoSelected do + AMatrix[i-1,j-1] := BCSums[i-1,j-1] / (NinGrp * NoAGrps); + end; + for j := 1 to NoSelected do + begin + LabelStr := format('C%d',[j]); + ColLabels[j-1] := LabelStr; + end; + MatPrint(AMatrix,NoBGrps,NoSelected,Title,RowLabels,ColLabels,NinGrp*NoAGrps, AReport); + +// OutputFrm.ShowModal; +end; + +procedure TABRAnovaFrm.BoxTests(AReport: TStrings); +const + EPS = 1E-35; +var + XVector, XSums : DblDyneVec; + DetMat, MeanCovMat : DblDyneMat; + M1, M2, Sum1, C1, C2, f1, f2, chi, ProbChi, X, avgvar,avgcov : double; + ColHeader, LabelStr : string; + Title : string; + i, j, k, l, row, SubjA, SubjB, N, p, quad : integer; + errorcode : boolean = false; // to silence the compiler + Det: Double = 0.0; +begin + SetLength(XVector,NoSelected); + SetLength(XSums,NoSelected); + SetLength(DetMat,NoSelected+1,NoSelected+1); + SetLength(MeanCovMat,NoSelected+1,NoSelected+1); + SetLength(PooledMat,NoSelected+1,NoSelected+1); + + for i := 1 to NoSelected do + begin + LabelStr := format('C%d',[i]); + RowLabels[i-1] := LabelStr; + ColLabels[i-1] := LabelStr; + for j := 1 to NoSelected do PooledMat[i-1,j-1] := 0.0; + end; + + // get variance-covariance AMatrix for the repeated measures within + // each combination of A and B levels. Pool them for the pooled + // covariance AMatrix. Get Determinants of each AMatrix. + //OutputFrm.Clear; + Sum1 := 0.0; + for i := 1 to NoAGrps do + begin + for j := 1 to NoBGrps do + begin + LabelStr := format('Variance-Covariance AMatrix for A%d B%d', [i,j]); + Title := LabelStr; + ColHeader := 'C Levels'; + + // initialize AMatrix for this combination + for k := 1 to NoSelected do + begin + for l := 1 to NoSelected do AMatrix[k-1,0] := 0.0; + XSums[k-1] := 0.0; + end; + + // read data and add to covariances + for row := 1 to NoCases do + begin + if not GoodRecord(row,selected,ColNoSelected) then + continue; + SubjA := round(StrToFLoat(Trim(OS3MainFrm.DataGrid.Cells[ACol,row]))); + SubjA := SubjA - MinA + 1; + SubjB := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[BCol,row]))); + SubjB := SubjB - MinB + 1; + if ((SubjA <> i)or(SubjB <> j)) then + continue; + for k := 1 to NoSelected do + begin + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNoSelected[k-1],row])); + XVector[k-1] := X; + XSums[k-1] := XSums[k-1] + X; + end; + for k := 1 to NoSelected do + begin + for l := 1 to NoSelected do + AMatrix[k-1,l-1] := AMatrix[k-1,l-1] + (XVector[k-1] * XVector[l-1]); + end; + end; // next case + + // convert sums of cross-products to variance-covariance + for k := 1 to NoSelected do + begin + for l := 1 to NoSelected do + begin + AMatrix[k-1,l-1] := AMatrix[k-1,l-1] - (XSums[k-1]*XSums[l-1] / NinGrp); + AMatrix[k-1,l-1] := AMatrix[k-1,l-1] / (NinGrp - 1); + PooledMat[k-1,l-1] := PooledMat[k-1,l-1] + AMatrix[k-1,l-1]; + end; + end; + + MatPrint(AMatrix,NoSelected,NoSelected,Title,RowLabels,ColLabels,NoCases, AReport); + + for k := 1 to NoSelected do + for l := 1 to NoSelected do + DetMat[k-1,l-1] := AMatrix[k-1,l-1]; + Determ(DetMat,NoSelected, NoSelected, Det, errorcode); + // if (Det > 0.0e35) then // wp: What's this??? + if Det > EPS then + Sum1 := sum1 + (NinGrp * ln(Det)) + else + MessageDlg('Determinant of a covariance AMatrix <= 0.', mtWarning, [mbOK], 0); + end;// next B level + end; // next A level + + // get pooled variance-covariance + for i := 1 to NoSelected do + for j := 1 to NoSelected do + PooledMat[i-1,j-1] := PooledMat[i-1,j-1] / (NoAGrps * NoBGrps); + + Title := 'Pooled Variance-Covariance AMatrix'; + MatPrint(PooledMat,NoSelected,NoSelected,Title,RowLabels,ColLabels,NoCases, AReport); + + // calculate F-Max for variance homogeneity + + // calculate Box test for covariance homogeneity + for i := 1 to NoSelected do + for j := 1 to NoSelected do + DetMat[i-1,j-1] := PooledMat[i-1,j-1]; + Determ(DetMat,NoSelected,NoSelected,Det,errorcode); + //if (Det > 0.0e35) then + if (Det > EPS) then + begin + M1 := (NinGrp*NoAGrps*NoBGrps * ln(Det)) - Sum1; + C1 := (2.0 * NoSelected * NoSelected + 3.0 * NoSelected - 1.0) / + (6.0 * (NoSelected+1) * (NoAGrps * NoBGrps - 1.0)); + C1 := C1 * ( (NoAGrps * NoBGrps * (1.0 / NinGrp)) - (1.0 / (NinGrp * NoAGrps * NoBGrps))); + f1 := (NoSelected * (NoSelected + 1.0) * (NoAGrps * NoBGrps - 1.0))/2.0; + chi := (1.0 - C1) * M1; + ProbChi := 1.0 - chisquaredprob(chi,round(f1)); + AReport.Add('Test that sample covariances are from same population:'); + AReport.Add(''); + AReport.Add('Chi-Squared = %0.3f with %d degrees of freedom.', [chi,round(f1)]); + AReport.Add('Probability of > Chi-Squared = %0.3f', [ProbChi]); + AReport.Add(''); + AReport.Add(''); + end else + MessageDlg('Determinant of a pooled covariance AMatrix near 0.', mtError, [mbOK], 0); + + // test that pooled covariance has form of equal variances and equal covariances + //if (Det > 0.0e35) then // determinant of pooled covariance > 0 + if (Det > EPS) then + begin + M2 := Det; + avgvar := 0.0; + for i := 1 to NoSelected do + avgvar := avgvar + PooledMat[i-1,i-1]; + avgvar := avgvar / NoSelected; + avgcov := 0.0; + for i := 1 to NoSelected-1 do + for j := i+1 to NoSelected do + avgcov := avgcov + PooledMat[i-1,j-1]; + avgcov := avgcov / (NoSelected * (NoSelected - 1) / 2); + for i := 1 to NoSelected do + DetMat[i-1,i-1] := avgvar; + for i := 1 to NoSelected-1 do + begin + for j := i+1 to NoSelected do + begin + DetMat[i-1,j-1] := avgcov; + DetMat[j-1,i-1] := avgcov; + end; + end; + Determ(DetMat,NoSelected,NoSelected,Det,errorcode); +// if (Det > 0.0e35) then + if (Det > EPS) then + begin + N := NoAGrps * NoBGrps * NinGrp; + p := NoAGrps * NoBGrps; + quad := NoSelected * NoSelected + NoSelected - 4; + M2 := ln(M2 / Det); + M2 := -(N - p) * M2; + C2 := NoSelected * (NoSelected + 1) * (NoSelected + 1) * (2 * NoSelected - 3); + C2 := C2 / (6 * (N - p) * (NoSelected - 1) * quad); + f2 := quad / 2; + chi := (1.0 - C2) * M2; + ProbChi := 1.0 - chisquaredprob(chi,round(f2)); + AReport.Add('Test that variance-covariances AMatrix has equal variances and equal covariances:'); + AReport.Add(''); + AReport.Add('Chi-Squared := %0.3f with %d degrees of freedom.', [chi, round(f2)]); + AReport.Add('Probability of > Chi-Squared := %.3f', [ProbChi]); + AReport.Add(''); + end else + MessageDlg('Determinant of theoretical covariance AMatrix near zero.', mtWarning, [mbOK], 0); + end; +// OutputFrm.ShowModal; + + // cleanup + PooledMat := nil; + MeanCovMat := nil; + DetMat := nil; + XSums := nil; + XVector := nil; +end; + +procedure TABRAnovaFrm.GraphMeans; +var + MaxMean : double; + i, j : integer; +begin + // Do AB interaction + // Get maximum cell mean + MaxMean := ABSums[0,0] / (NinGrp*NoSelected); + SetLength(GraphFrm.Ypoints,NoAGrps,NoBGrps); + SetLength(GraphFrm.Xpoints,1,NoBGrps); + for i := 1 to NoAGrps do + begin + GraphFrm.SetLabels[i] := 'A ' + IntToStr(i); + for j := 1 to NoBGrps do + begin + GraphFrm.Ypoints[i-1,j-1] := ABSums[i-1,j-1] / (NinGrp * NoSelected); + if GraphFrm.Ypoints[i-1,j-1] > MaxMean then MaxMean := GraphFrm.Ypoints[i-1,j-1]; + end; + end; + for j := 1 to NoBGrps do + begin + GraphFrm.Xpoints[0,j-1] := j; + end; + + GraphFrm.nosets := NoAGrps; + GraphFrm.nbars := NoBGrps; + GraphFrm.Heading := 'AxBxR ANOVA'; + GraphFrm.XTitle := 'B TREATMENT GROUP'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.GraphType := 2; // 3d Vertical Bar Chart + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + + // Do AC interaction + MaxMean := ACSums[0,0] / (NinGrp*NoBGrps); + SetLength(GraphFrm.Ypoints,NoAGrps,NoSelected); + SetLength(GraphFrm.Xpoints,1,NoSelected); + for i := 1 to NoAGrps do + begin + GraphFrm.SetLabels[i] := 'A ' + IntToStr(i); + for j := 1 to NoSelected do + begin + GraphFrm.Ypoints[i-1,j-1] := ACSums[i-1,j-1] / (NinGrp * NoBGrps); + if GraphFrm.Ypoints[i-1,j-1] > MaxMean then MaxMean := GraphFrm.Ypoints[i-1,j-1]; + end; + end; + for j := 1 to NoSelected do + begin + GraphFrm.Xpoints[0,j-1] := j; + end; + GraphFrm.nosets := NoAGrps; + GraphFrm.nbars := NoSelected; + GraphFrm.Heading := 'AxBxR ANOVA'; + GraphFrm.XTitle := 'C TREATMENT (WITHIN SUBJECTS) GROUP'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.GraphType := 2; // 3d Vertical Bar Chart + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + + // Do BC interaction + SetLength(GraphFrm.Ypoints,NoBGrps,NoSelected); + SetLength(GraphFrm.Xpoints,NoSelected); + MaxMean := BCSums[0,0] / (NinGrp*NoAGrps); + for i := 1 to NoBGrps do + for j := 1 to NoSelected do + if ((BCSums[i-1,j-1] / (NinGrp*NoAGrps)) > MaxMean) then + MaxMean := BCSums[i-1,j-1] / (NinGrp*NoAGrps); + for i := 1 to NoBGrps do + begin + GraphFrm.SetLabels[i] := 'B ' + IntToStr(i); + for j := 1 to NoSelected do + begin + GraphFrm.Ypoints[i-1,j-1] := BCSums[i-1,j-1] / (NinGrp * NoAGrps); + if GraphFrm.Ypoints[i-1,j-1] > MaxMean then MaxMean := GraphFrm.Ypoints[i-1,j-1]; + end; + end; + for j := 1 to NoSelected do + begin + GraphFrm.Xpoints[0,j-1] := j; + end; + GraphFrm.nosets := NoBGrps; + GraphFrm.nbars := NoSelected; + GraphFrm.Heading := 'AxBxR ANOVA'; + GraphFrm.XTitle := 'C TREATMENT (WITHIN SUBJECTS) GROUP'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.GraphType := 2; // 3d Vertical Bar Chart + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + // cleanup the heap + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +procedure TABRAnovaFrm.CleanUp; +begin + ABCNcnt := nil; + ABCSums := nil; + ColLabels := nil; + RowLabels := nil; + Ccnt := nil; + Bcnt := nil; + Acnt := nil; + SumPSqr := nil; + AMatrix := nil; + BCSums := nil; + ACSums := nil; + ABSums := nil; + CSums := nil; + BSums := nil; + ASums := nil; + ColNoSelected := nil; +end; + +procedure TABRAnovaFrm.CListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TABRAnovaFrm.UpdateBtnStates; +var + lSelected: Boolean; + i: Integer; +begin + AInBtn.Enabled := (VarList.ItemIndex > -1) and (ACodes.Text = ''); + AOutBtn.Enabled := (ACodes.Text <> ''); + + BInBtn.Enabled := (VarList.ItemIndex > -1) and (BCodes.Text = ''); + BOutBtn.Enabled := (BCodes.Text <> ''); + + lSelected := false; + for i := 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + CInBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to CList.Items.Count-1 do + if CList.Selected[i] then + begin + lSelected := true; + break; + end; + COutBtn.Enabled := lSelected; +end; + +initialization + {$I abranovaunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/ancovaunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/ancovaunit.lfm new file mode 100644 index 000000000..3fb0c0abd --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/ancovaunit.lfm @@ -0,0 +1,633 @@ +object ANCOVAfrm: TANCOVAfrm + Left = 505 + Height = 525 + Top = 250 + Width = 486 + Caption = 'Analysis of Covariance Using Multiple Regression Methods' + ClientHeight = 525 + ClientWidth = 486 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel3 + Left = 8 + Height = 72 + Top = 404 + Width = 470 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + Caption = 'Output Options:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 16 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 3 + ClientHeight = 52 + ClientWidth = 466 + TabOrder = 1 + object DescriptiveStats: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 127 + Caption = 'Descriptive Statistics' + TabOrder = 0 + end + object CorrelationMats: TCheckBox + AnchorSideTop.Side = asrBottom + Left = 155 + Height = 19 + Top = 6 + Width = 169 + Caption = 'Correlation Matrices' + TabOrder = 1 + end + object PrintInverseMat: TCheckBox + AnchorSideTop.Side = asrBottom + Left = 340 + Height = 19 + Top = 6 + Width = 119 + Caption = 'Inverse of Matrices' + TabOrder = 2 + end + object PlotMeans: TCheckBox + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 27 + Width = 127 + Caption = 'Plot Factor Means' + TabOrder = 3 + end + object MultCompChk: TCheckBox + AnchorSideTop.Side = asrBottom + Left = 155 + Height = 19 + Top = 27 + Width = 169 + Caption = 'Show Multiple Comparisons' + TabOrder = 4 + end + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 384 + Top = 8 + Width = 470 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 384 + ClientWidth = 470 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 100 + Caption = 'Available Variables:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = DepVar + AnchorSideBottom.Control = DepVar + Left = 288 + Height = 15 + Top = 25 + Width = 102 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = FixedList + AnchorSideTop.Control = DepOut + AnchorSideTop.Side = asrBottom + Left = 288 + Height = 15 + Top = 101 + Width = 69 + BorderSpacing.Top = 24 + Caption = 'Fixed Factors' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = CovList + AnchorSideTop.Control = FixedList + AnchorSideTop.Side = asrBottom + Left = 288 + Height = 15 + Top = 253 + Width = 55 + BorderSpacing.Top = 24 + Caption = 'Covariates' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepIn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 367 + Top = 17 + Width = 244 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object DepIn: TBitBtn + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + Left = 252 + Height = 28 + Top = 17 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInClick + Spacing = 0 + TabOrder = 1 + end + object DepOut: TBitBtn + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = DepIn + AnchorSideTop.Side = asrBottom + Left = 252 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutClick + Spacing = 0 + TabOrder = 2 + end + object FixedIn: TBitBtn + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + Left = 252 + Height = 28 + Top = 144 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = FixedInClick + Spacing = 0 + TabOrder = 4 + end + object FixedOut: TBitBtn + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Bevel2 + AnchorSideTop.Side = asrBottom + Left = 252 + Height = 28 + Top = 175 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = FixedOutClick + Spacing = 0 + TabOrder = 5 + end + object CovIn: TBitBtn + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CovList + Left = 252 + Height = 28 + Top = 270 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = CovInClick + Spacing = 0 + TabOrder = 7 + end + object CovOut: TBitBtn + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CovIn + AnchorSideTop.Side = asrBottom + Left = 252 + Height = 28 + Top = 302 + Width = 28 + BorderSpacing.Top = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = CovOutClick + Spacing = 0 + TabOrder = 8 + end + object DepVar: TEdit + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOut + AnchorSideBottom.Side = asrBottom + Left = 288 + Height = 23 + Top = 42 + Width = 182 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'DepVar' + end + object CovList: TListBox + AnchorSideLeft.Control = CovIn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 288 + Height = 114 + Top = 270 + Width = 182 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 9 + end + object FixedList: TListBox + AnchorSideLeft.Control = FixedIn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 288 + Height = 111 + Top = 118 + Width = 182 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 6 + end + object Bevel2: TBevel + AnchorSideLeft.Control = VarList + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = FixedList + AnchorSideTop.Side = asrCenter + Left = 252 + Height = 4 + Top = 171 + Width = 24 + Shape = bsSpacer + end + object Bevel1: TBevel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + Left = 218 + Height = 18 + Top = 2 + Width = 34 + Shape = bsSpacer + end + end + object Panel2: TPanel + Left = 8 + Height = 25 + Top = 492 + Width = 470 + Align = alBottom + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 25 + ClientWidth = 470 + TabOrder = 2 + object ResetBtn: TButton + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = ComputeBtn + Left = 269 + Height = 25 + Top = 0 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = CloseBtn + Left = 331 + Height = 25 + Top = 0 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object CloseBtn: TButton + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 415 + Height = 25 + Top = 0 + Width = 55 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Close' + ModalResult = 11 + TabOrder = 3 + end + object HelpBtn: TButton + Tag = 103 + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = ResetBtn + Left = 210 + Height = 25 + Top = 0 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Right = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 0 + end + end + object Bevel3: TBevel + Left = 0 + Height = 8 + Top = 476 + Width = 486 + Align = alBottom + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/ancovaunit.pas b/applications/lazstats/source/forms/analysis/comparisons/ancovaunit.pas new file mode 100644 index 000000000..83a24d117 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/ancovaunit.pas @@ -0,0 +1,1342 @@ +// Use file "ancova.laz" for testing. +// Y --> Dependent Variable +// Group --> Fixed Factors +// X, Z ---> Covariables + +unit ANCOVAUnit; + +{$mode objfpc}{$H+} +{.$DEFINE ANCOVA_DEBUG} + +interface + +uses + {$IFDEF ANCOVA_DEBUG} + LazLogger, + {$ENDIF} + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, GraphLib, + Globals, DataProcs, MatrixLib, DictionaryUnit, ContextHelpUnit; + +type + + { TANCOVAfrm } + + TANCOVAfrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + Bevel3: TBevel; + HelpBtn: TButton; + MultCompChk: TCheckBox; + Panel1: TPanel; + Panel2: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + PlotMeans: TCheckBox; + PrintInverseMat: TCheckBox; + CorrelationMats: TCheckBox; + DescriptiveStats: TCheckBox; + DepIn: TBitBtn; + DepOut: TBitBtn; + FixedIn: TBitBtn; + FixedOut: TBitBtn; + CovIn: TBitBtn; + CovOut: TBitBtn; + DepVar: TEdit; + GroupBox1: TGroupBox; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + FixedList: TListBox; + Label4: TLabel; + CovList: TListBox; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure CovInClick(Sender: TObject); + procedure CovOutClick(Sender: TObject); + procedure DepInClick(Sender: TObject); + procedure DepOutClick(Sender: TObject); + procedure FixedInClick(Sender: TObject); + procedure FixedOutClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + NCases, NoSelected, NoFixed, NoCovs, DepColNo : integer; + ColNoSelected : IntDyneVec; // Grid col. no's of predictors + RowLabels, ColLabels : StrDyneVec; + CorMat : DblDyneMat; // correlation matrix + IndMat : DblDyneMat; // correlation matrix among independent variables + BetaWeights : DblDyneVec; // standardized regression weights + Means, Variances, StdDevs : DblDyneVec; + PrintIt : boolean; // true to print correlations in reg procedure + probout : double; // probability for removing a variable + Testout : boolean; // true if testing for retention of variables + plot : boolean; // if true, plot group means + StdErrEst : double; // standard error of estimate + multcomp : boolean; // if true make multiple comparisons + R2 : double; // squared multiple correlation coefficient + FixedCols : IntDyneVec; // grid columns of fixed variables + CovCols : IntDyneVec; // grid columns of covariates + mingrp, maxgrp : IntDyneVec; // min and max group codes + Block : IntDyneMat; // descriptors for group codings + // values 1 to 5 contain group min, max, startcol, endcol and no. of vectors + NoBlocks : integer; // number of vector blocks created for groups and inter. + errorcode : boolean; // returned by routines that use an errorcode + IndepIndex : IntDyneVec; // sequential number of predictors in corr. matrix + BlockLabel : StrDyneVec; + NoTestVecs : integer; // no. of vectors for group interactions with covariates + constant : double; // regression constant + noind : integer; // no. of independent variables in a regression analysis + BWeights : DblDyneVec; // raw regression weights +// BStdErrs : DblDyneVec; // standard errors of regression weights +// BTtests : DblDyneVec; + + procedure GetParms; + procedure CodeGroups; + procedure GenInteractions; + procedure DoRegs(AReport: TStrings); + procedure CleanUp; + procedure EntryOpt1(AReport: TStrings); + procedure GenCovInteracts; + procedure AdjustMeans(AReport: TStrings); + procedure MultCompare(AReport: TStrings); + + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + ANCOVAfrm: TANCOVAfrm; + +implementation + +uses + Math; + +{ TANCOVAfrm } + +procedure TANCOVAfrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + DepVar.Text := ''; + VarList.Clear; + CovList.Clear; + FixedList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + DescriptiveStats.Checked := false; + CorrelationMats.Checked := false; + PrintInverseMat.Checked := false; + PlotMeans.Checked := false; + NoBlocks := 0; + UpdateBtnStates; +end; + +procedure TANCOVAfrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TANCOVAfrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TANCOVAfrm.DepInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepVar.Text = '') then + begin + DepVar.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TANCOVAfrm.CovInClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + CovList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TANCOVAfrm.ComputeBtnClick(Sender: TObject); +var + lReport: TStrings; +begin + if DepVar.Text = '' then + begin + MessageDlg('No dependent variable selected.', mtError, [mbOK], 0); + exit; + end; + + NoFixed := FixedList.Items.Count; + NoCovs := CovList.Items.Count; + if (NoFixed <= 0) or (NoCovs <= 0) then + begin + MessageDlg('You must have at least one group variable and one covariate', mtError, [mbOK], 0); + exit; + end; + + lReport := TStringList.Create; + try + GetParms; + CodeGroups; + GenInteractions; + GenCovInteracts; + DoRegs(lReport); + DisplayReport(lReport); + finally + CleanUp; + lReport.Free; + end; +end; + +procedure TANCOVAfrm.CovOutClick(Sender: TObject); +var + i: Integer; +begin + i := 0; + while i < CovList.Items.Count do + begin + if CovList.Selected[i] then + begin + Varlist.Items.Add(CovList.Items[i]); + CovList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TANCOVAfrm.DepOutClick(Sender: TObject); +begin + if DepVar.Text <> '' then + begin + VarList.Items.Add(DepVar.Text); + DepVar.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TANCOVAfrm.FixedInClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + FixedList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TANCOVAfrm.FixedOutClick(Sender: TObject); +var + i : integer; +begin + i := 0; + while i < FixedList.Items.Count do + begin + if FixedList.Selected[i] then + begin + VarList.Items.Add(FixedList.Items[i]); + FixedList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TANCOVAfrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TANCOVAfrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TANCOVAfrm.GetParms; +var + i, j: integer; +begin + SetLength(ColNoSelected, NoVariables); + SetLength(FixedCols, NoFixed); + SetLength(CovCols, NoCovs); + SetLength(mingrp, NoFixed); + SetLength(maxgrp, NoFixed); + SetLength(Block, 100, 5); + SetLength(BlockLabel, 100); + + NoSelected := 0; + NoBlocks := 0; + plot := PlotMeans.Checked; + multcomp := MultCompChk.Checked; + + for i := 1 to NoVariables do + begin + if DepVar.Text = OS3MainFrm.DataGrid.Cells[i,0] then + begin + DepColNo := i; + ColNoSelected[0] := i; + NoSelected := 1; + break; + end; + end; + + for i := 0 to NoFixed - 1 do + begin + for j := 1 to NoVariables do + begin + if FixedList.Items.Strings[i] = OS3MainFrm.DataGrid.Cells[j,0] then + begin + FixedCols[i] := j; + ColNoSelected[NoSelected] := j; + NoSelected := NoSelected + 1; + break; + end; + end; + end; + + for i := 0 to NoCovs - 1 do + begin + for j := 1 to NoVariables do + begin + if CovList.Items.Strings[i] = OS3MainFrm.DataGrid.Cells[j,0] then + begin + CovCols[i] := j; + ColNoSelected[NoSelected] := j; + NoSelected := NoSelected + 1; + break; + end; + end; + end; + + // create a "Block" for each covariate + for i := 0 to NoCovs-1 do + begin + NoBlocks := NoBlocks + 1; + Block[i,0] := 0; // group min + Block[i,1] := 0; // group max + Block[i,2] := CovCols[i]; // start column in grid + Block[i,3] := CovCols[i]; // end column in grid + Block[i,4] := 1; // no. of vectors + BlockLabel[i] := 'Cov' + IntToStr(i); + end; +end; + +procedure TANCOVAfrm.CodeGroups; +var + col, i, j, value: integer; + factlabel, cellstring: string; + startcol: Integer = 0; // to silence the compiler + endcol: Integer = 0; + noVectors: Integer = 0; +begin + // create a block for code vectors of each fixed variable + for i := 0 to NoFixed-1 do + begin + col := FixedCols[i]; + factlabel := chr(ord('A')+i); + mingrp[i] := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,1]))); + maxgrp[i] := mingrp[i]; + for j := 1 to NoCases do + begin + if not GoodRecord(j,NoSelected,ColNoSelected) then continue; + cellstring := Trim(OS3MainFrm.DataGrid.Cells[col,j]); + value := round(StrToFloat(cellstring)); + if value < mingrp[i] then mingrp[i] := value; + if value > maxgrp[i] then maxgrp[i] := value; + end; + + // create fixed effect coding for levels - 1 of the fixed effect var. + EffectCode(col, mingrp[i], maxgrp[i], factlabel, startcol, endcol, novectors); + NoBlocks := NoBlocks + 1; + Block[NoBlocks-1,0] := mingrp[i]; + Block[NoBlocks-1,1] := maxgrp[i]; + Block[NoBlocks-1,2] := startcol; + Block[NoBlocks-1,3] := endcol; + Block[NoBlocks-1,4] := novectors; + BlockLabel[NoBlocks-1] := factlabel; + end; // next factor block +end; + +procedure TANCOVAfrm.GenInteractions; +type + Twoway = array[0..9,0..1] of integer; + Threeway = array[0..9,0..2] of integer; + Fourway = array[0..4,0..3] of integer; +const + Twoways: Twoway = ( + (1,2), (1,3), (2,3), (1,4), (2,4), (3,4), (1,5), (2,5), (3,5), (4,5) + ); + Threeways: Threeway = ( + (1,2,3), (1,2,4), (1,3,4), (2,3,4), (1,2,5), + (1,3,5), (1,4,5), (2,3,5), (2,4,5), (3,4,5) + ); + Fourways: Fourway = ( + (1,2,3,4), (1,2,3,5), (1,2,4,5), (1,3,4,5), (2,3,4,5) + ); +var + i, j, k, l, m, n, col, value: integer; + labelstr: string; + startcol, endcol, novectors, oldnovars: integer; + cell1, cell2, cell3, cell4: string; + TwoWayCombos, ThreeWayCombos, FourwayCombos: double; + Block1, Block2, Block3, Block4, Start1, End1, Start2, End2, Start3, End3: integer; + Start4, End4: integer; +begin + novectors := 0; + + // Do two-way interactions + if NoFixed < 2 then + exit; + TwoWayCombos := round(combos(2.0, NoFixed)); + oldnovars := NoVariables; + for i := 0 to round(TwoWayCombos)-1 do + begin + Block1 := TwoWays[i,0] + NoCovs - 1; + Block2 := TwoWays[i,1] + NoCovs - 1; + Start1 := Block[Block1,2]; + End1 := Block[Block1,3]; + Start2 := Block[Block2,2]; + End2 := Block[Block2,3]; + oldnovars := NoVariables; + startcol := Block[NoBlocks-1,3] + 1; + col := NoVariables; + for j := Start1 to End1 do + begin + for k := Start2 to End2 do + begin + col := col + 1; + novectors := novectors + 1; + DictionaryFrm.NewVar(col); + labelstr := OS3MainFrm.DataGrid.Cells[j,0] + 'x'; + labelstr := labelstr + OS3MainFrm.DataGrid.Cells[k,0]; + OS3MainFrm.DataGrid.Cells[col,0] := labelstr; + DictionaryFrm.DictGrid.Cells[1,col] := labelstr; + for m := 1 to NoCases do + begin + if not GoodRecord(m,NoSelected,ColNoSelected) then Continue; + cell1 := Trim(OS3MainFrm.DataGrid.Cells[j,m]); + cell2 := Trim(OS3MainFrm.DataGrid.Cells[k,m]); + value := round(StrToFloat(cell1)) * round(StrToFloat(cell2)); + OS3MainFrm.DataGrid.Cells[col,m] := IntToStr(value); + end; + end; + endcol := col; + NoBlocks := NoBlocks + 1; + Block[NoBlocks-1,0] := 0; // zeroes for interactions + Block[NoBlocks-1,1] := 0; // zeroes for interactions + Block[NoBlocks-1,2] := startcol; // grid start col for 2-way interactions + Block[NoBlocks-1,3] := endcol; // grid end col for 2-way interactions + Block[NoBlocks-1,4] := novectors; // no. of vectors for 2-way interaction + BlockLabel[NoBlocks-1] := BlockLabel[Block1] + 'x' + BlockLabel[Block2]; + NoVariables := oldnovars + novectors; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + novectors := 0; + end; // end of interaction of fixed effect vectors j and fixed effect vectors k + end; // end of 2 way interactions + + // do 3-way interactions using group vectors and two way interaction vectors + if (NoFixed < 3) then + exit; + ThreeWayCombos := Combos(3.0, NoFixed); + for i := 0 to round(ThreeWayCombos)-1 do + begin + startcol := Block[NoBlocks-1,3] + 1; // next column after last block + col := NoVariables; + Block1 := ThreeWays[i,0] + NoCovs - 1; + Block2 := ThreeWays[i,1] + NoCovs - 1; + Block3 := ThreeWays[i,2] + NoCovs - 1; + Start1 := Block[Block1,2]; + End1 := Block[Block1,3]; + Start2 := Block[Block2,2]; + End2 := Block[Block2,3]; + Start3 := Block[Block3,2]; + End3 := Block[Block3,3]; + oldnovars := NoVariables; + novectors := 0; + for j := Start1 to End1 do + begin + for k := Start2 to End2 do + begin + for l := Start3 to End3 do // no. vectors in first factor + begin + col := col + 1; + novectors := novectors + 1; + DictionaryFrm.NewVar(col); + labelstr := OS3MainFrm.DataGrid.Cells[j,0] + 'x'; + labelstr := labelstr + OS3MainFrm.DataGrid.Cells[k,0]; + labelstr := labelstr + 'x' + OS3MainFrm.DataGrid.Cells[l,0]; + OS3MainFrm.DataGrid.Cells[col,0] := labelstr; + DictionaryFrm.DictGrid.Cells[1,col] := labelstr; + for m := 1 to NoCases do + begin + if not GoodRecord(m,NoSelected,ColNoSelected) then Continue; + cell1 := Trim(OS3MainFrm.DataGrid.Cells[j,m]); + cell2 := Trim(OS3MainFrm.DataGrid.Cells[k,m]); + cell3 := Trim(OS3MainFrm.DataGrid.Cells[l,m]); + value := round(StrToFloat(cell1)) * round(StrToFloat(cell2)) * round(StrToFloat(cell3)); + OS3MainFrm.DataGrid.Cells[col,m] := IntToStr(value); + end; // next case m + end; // next third variable + end; // next second variable + end; // end of interaction of fixed effects vectors for j, k and l + endcol := col; // last grid column containing three-way interaction vectors + NoBlocks := NoBlocks + 1; + Block[NoBlocks-1,0] := 0; // zeroes for interactions + Block[NoBlocks-1,1] := 0; // zeroes for interactions + Block[NoBlocks-1,2] := startcol; // grid start col for 2-way interactions + Block[NoBlocks-1,3] := endcol; // grid end col for 2-way interactions + Block[NoBlocks-1,4] := novectors; // no. of vectors for 2-way interaction + BlockLabel[NoBlocks-1] := BlockLabel[Block1] + 'x' + BlockLabel[Block2] + 'x' + BlockLabel[Block3]; + NoVariables := oldnovars + novectors; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + end; // end of three way interactions + + // do 4-way interactions using group and 3-way interaction vectors + if (NoFixed < 4) then + exit; + FourWayCombos := combos(4.0,NoFixed); + for i := 0 to round(FourWayCombos) - 1 do + begin + startcol := Block[NoBlocks-1][3] + 1; + col := NoVariables; + Block1 := FourWays[i][0] + NoCovs - 1; // block # for first fixed effect + Block2 := FourWays[i][1] + NoCovs - 1; // block # for second fixed effect + Block3 := FourWays[i][2] + NoCovs - 1; // block # for third fixed effect + Block4 := FourWays[i][3] + NoCovs - 1; // block # for fourth fixed effect + Start1 := Block[Block1][2]; + End1 := Block[Block1][3]; + Start2 := Block[Block2][2]; + End2 := Block[Block2][3]; + Start3 := Block[Block3][2]; + End3 := Block[Block3][3]; + Start4 := Block[Block4][2]; + End4 := Block[Block4][3]; + oldnovars := NoVariables; + novectors := 0; + for j := Start1 to End1 do // vector in first fixed factor + begin + for k := Start2 to End2 do // vector in second fixed factor + begin + for l := Start3 to End3 do // vector in third fixed factor + begin + for m := Start4 to End4 do // vecotr in fourth fixed factor + begin + col := col + 1; + novectors := novectors + 1; + DictionaryFrm.NewVar(col); + labelstr := OS3MainFrm.DataGrid.Cells[j,0] + 'x'; + labelstr := labelstr + OS3MainFrm.DataGrid.Cells[k,0]; + labelstr := labelstr + 'x' + OS3MainFrm.DataGrid.Cells[l,0]; + OS3MainFrm.DataGrid.Cells[col,0] := labelstr; + DictionaryFrm.DictGrid.Cells[1,col] := labelstr; + for n := 1 to NoCases do + begin + cell1 := Trim(OS3MainFrm.DataGrid.Cells[j,n]); + cell2 := Trim(OS3MainFrm.DataGrid.Cells[k,n]); + cell3 := Trim(OS3MainFrm.DataGrid.Cells[l,n]); + cell4 := Trim(OS3MainFrm.DataGrid.Cells[m,n]); + value := round(StrToFloat(cell1)) * + round(StrToFloat(cell2)) * + round(StrToFloat(cell3)) * + round(StrToFloat(cell4)); + OS3MainFrm.DataGrid.Cells[col,n] := IntToStr(value); + end; // next case n + end; // next fourth vector m + end; // next third vector + end; // next second vector + end; // end of interaction of fixed effects vectors for j, k and l and m + + endcol := col; // last grid column containing four-way interaction vectors + NoBlocks := NoBlocks + 1; + Block[NoBlocks-1][0] := 0; // zeroes for interactions + Block[NoBlocks-1][1] := 0; // zeroes for interactions + Block[NoBlocks-1][2] := startcol; // grid start col for 4-way interactions + Block[NoBlocks-1][3] := endcol; // grid end col for 4-way interactions + Block[NoBlocks-1][4] := novectors; // no. of vectors for 2-way interaction + BlockLabel[NoBlocks-1] := BlockLabel[Block1] + 'x' + + BlockLabel[Block2] + 'x' + + BlockLabel[Block3] + 'x' + BlockLabel[Block4]; + NoVariables := oldnovars + novectors; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + end; // end of four-way combinations +end; + +procedure TANCOVAfrm.DoRegs(AReport: TStrings); +var + count: integer; + i, j: integer; +begin + {$IFDEF ANCOVA_DEBUG} + DebugLn('ENTER DoRegs'); + {$ENDIF} + + // get count of variables used + count := 0; + for i := 0 to NoBlocks - 1 do + for j := 0 to Block[i,4] do count := count + 1; + + {$IFDEF ANCOVA_DEBUG} + WriteLn('DoRegs: Count = ', count); + {$ENDIF} + + SetLength(BetaWeights,count+1); + SetLength(BWeights,count+2); +// SetLength(BStdErrs,count+1); +// SetLength(BTtests,count+1); + SetLength(Means,count+1); + SetLength(Variances,count+1); + SetLength(StdDevs,count+1); + SetLength(RowLabels,count+1); + SetLength(ColLabels,count+1); + SetLength(Cormat,count+1,count+1); + SetLength(Indmat,count+1,count+1); + SetLength(IndepIndex,count+1); + SetLength(ColNoSelected,count+1); + + PrintIt := CorrelationMats.Checked; + + Testout := false; + Probout := 0.99; + AReport.Add('ANALYSIS OF COVARIANCE USING MULTIPLE REGRESSION'); + AReport.Add(''); + AReport.Add('File Analyzed: ' + OS3MainFrm.FileNameEdit.Text); + AReport.Add(''); + + EntryOpt1(AReport); // factors, interactions and covariats concurrently + + IndepIndex := nil; + {$IFDEF ANCOVA_DEBUG} + DebugLn('EXIT DoRegs'); + {$ENDIF} +end; + +procedure TANCOVAfrm.CleanUp; +begin + Indmat := nil; + Cormat := nil; + ColLabels := nil; + RowLabels := nil; + StdDevs := nil; + Variances := nil; + Means := nil; +// BTtests := nil; +// BStdErrs := nil; + BWeights := nil; + BetaWeights := nil; + maxgrp := nil; + mingrp := nil; + CovCols := nil; + FixedCols := nil; + ColNoSelected := nil +end; + +procedure TANCOVAfrm.EntryOpt1(AReport: TStrings); +var + i, j, k, col, count: integer; + Title: string; + FullR2: double; + F: double; + Prob: double; + df1, df2: double; + SSGroups: double; + MSGroups: double; + SSError: double; + MSError: double; + SSTotal: double; +// SSExplained: double; + SSGrpTot: double = 0.0; + tProbs: DblDyneVec; + BTtests: DblDyneVec; + BStdErrs: DblDyneVec; // standard errors of regression weights + localReport: TStrings; +begin + {$IFDEF ANCOVA_DEBUG} + DebugLn('ENTER EntryOpt1'); + {$ENDIF} + + // factors, interactions and covariates concurrently (full model) + // get grid column numbers of all vectors and dependent variable + + AReport.Add(''); + AReport.Add('MODEL FOR TESTING ASSUMPTION OF ZERO INTERACTIONS WITH COVARIATES'); + AReport.Add(''); + + count := 0; + for i := 1 to NoBlocks do // no. of vector blocks + begin + for j := 1 to Block[i-1,4] do // no of vectors in block + begin + col := Block[i-1,2] + j - 1; // count from beginning col. + count := count + 1; + ColNoSelected[count-1] := col; + IndepIndex[count-1] := count; + RowLabels[count-1] := OS3MainFrm.DataGrid.Cells[col,0]; + end; + end; + count := count + 1; + noind := count - 1; + ColNoSelected[count-1] := DepColNo; + IndepIndex[count-1] := count; + RowLabels[count-1] := OS3MainFrm.DataGrid.Cells[DepColNo,0]; + + // Get correlation matrix (note: dependent is last variable) + Correlations(count,ColNoSelected,CorMat,Means,Variances,StdDevs,errorcode,NCases); + if CorrelationMats.Checked then + begin + AReport.Add(''); + AReport.Add('================================================================================'); +// AReport.Add(''); + title := 'CORRELATION MATRIX'; + MatPrint(Cormat, count, count, title, RowLabels, RowLabels, NCases, AReport); + end; + + if DescriptiveStats.Checked then + begin + AReport.Add(''); + AReport.Add('================================================================================'); + DynVectorPrint(Means, count, 'MEANS', RowLabels, NCases, AReport); + AReport.Add('================================================================================'); + DynVectorPrint(Variances, count, 'VARIANCES', RowLabels, NCases, AReport); + AReport.Add('================================================================================'); + DynVectorPrint(StdDevs, count, 'STD. DEV.S', RowLabels, NCases, AReport); + AReport.Add('================================================================================'); + AReport.Add(''); + end; + + // Get regression + SetLength(tProbs, count); + printIt := false; + + SetLength(BStdErrs, noind+1); + SetLength(BTtests, noind+1); + MReg( + noind, ColNoSelected, DepColNo, RowLabels ,Means, Variances, StdDevs, + BWeights, BetaWeights, BStdErrs, BTtests, tProbs, R2, StdErrEst, NCases, errorcode, + printIt, AReport + ); + if not ErrorCode then + begin + FullR2 := R2; + SSTotal := Variances[count-1] * (NCases - 1); + SSGroups := FullR2 * SSTotal; + SSError := (1.0 - FullR2) * SSTotal; + df1 := noind; + df2 := NCases - noind - 1; + MSGroups := SSGroups / df1; + MSError := SSError / df2; + F := MSGroups / MSError; + Prob := probf(F,df1,df2); + AReport.Add(''); + AReport.Add('================================================================================'); + AReport.Add(''); + AReport.Add('Analysis of Variance for the Model to Test Regression Homogeneity'); + AReport.Add(' SOURCE Deg.F. SS MS F Prob>F'); + AReport.Add('%10s %10.0f %10.2f %10.2f %10.3f %10.4f', ['Explained', df1, SSGroups, MSGroups, F, Prob]); + AReport.Add('%10s %10.0f %10.2f %10.2f', ['Error', df2, SSError, MSError]); + AReport.Add('%10s %10d %10.2f', ['Total', NCases-1, SSTotal]); + AReport.Add(''); + AReport.Add('%12s %10.3f',['R Squared = ',R2]); + AReport.Add(''); + end; + + // Now do analysis without the interactions (Ancova model) + AReport.Add(''); + AReport.Add('================================================================================'); + AReport.Add(''); + AReport.Add('Model for Analysis of Covariance'); + AReport.Add(''); + + count := 0; + for i := 1 to NoBlocks - 1 do // no. of vector blocks + begin + for j := 1 to Block[i-1,4] do // no of vectors in block + begin + col := Block[i-1,2] + j - 1; // count from beginning col. + count := count + 1; + ColNoSelected[count-1] := col; + IndepIndex[count-1] := count; + RowLabels[count-1] := OS3MainFrm.DataGrid.Cells[col,0]; + end; + end; + count := count + 1; + noind := count - 1; + ColNoSelected[count-1] := DepColNo; + IndepIndex[count-1] := count; + RowLabels[count-1] := OS3MainFrm.DataGrid.Cells[DepColNo,0]; + + // Get correlation matrix (note dependent is last variable) + Correlations(count,ColNoSelected,Cormat,Means,Variances,StdDevs,errorcode,NCases); + // save in IndMat + for i := 0 to count-1 do + for j := 0 to count - 1 do + IndMat[i,j] := Cormat[i,j]; + + if CorrelationMats.Checked then + begin + AReport.Add(''); + Title := 'Correlation Matrix'; + MatPrint(Cormat, count, count, title, RowLabels, RowLabels, NCases, AReport); + end; + if DescriptiveStats.Checked then + begin + AReport.Add(''); + AReport.Add('================================================================================'); + DynVectorPrint(Means, count, 'MEANS', RowLabels, NCases, AReport); + AReport.Add('================================================================================'); + DynVectorPrint(Variances, count, 'VARIANCES', RowLabels, NCases, AReport); + AReport.Add('================================================================================'); + DynVectorPrint(StdDevs, count, 'STD. DEV.S', RowLabels, NCases, AReport); + AReport.Add('================================================================================'); + AReport.Add(''); + end; + + // Get regression + PrintIt := true; + SetLength(BStdErrs, noind+1); + SetLength(BTtests, noind+1); + + MReg( + noind, ColNoSelected, DepColNo, RowLabels, Means, Variances, StdDevs, + BWeights, BetaWeights, BStdErrs, BTtests, tProbs, R2, StdErrEst, NCases, + errorcode, false, AReport + ); + + if not ErrorCode then + begin + // test differences between previous and current models (= beta test) + constant := BWeights[noind]; + df1 := NoTestVecs; + F := ((FullR2 - R2) / df1) / ((1.0 - FullR2) / df2); + Prob := probf(F,df1,df2); + AReport.Add(''); + AReport.Add('================================================================================'); + AReport.Add(''); + AReport.Add('Test for Homogeneity of Group Regression Coefficients'); + AReport.Add('Change in R2 = %6.4f. F = %10.3f Prob.> F = %6.4f with d.f. %8.0f and %8.0f', [(FullR2 - R2), F, Prob, df1, df2]); + AReport.Add(''); + AReport.Add('%12s %10.3f',['R Squared = ', R2]); + + FullR2 := R2; + SSTotal := Variances[count-1] * (NCases - 1); + SSGroups := FullR2 * SSTotal; + SSError := (1.0 - FullR2) * SSTotal; + df1 := noind; + df2 := NCases - noind - 1; + MSGroups := SSGroups / df1; + MSError := SSError / df2; + + // obtain Adjusted means + // AdjustMeans(self); + // Make Comparisons among means + // if multcomp then MultCompare(self); + F := MSGroups / MSError; + Prob := probf(F,df1,df2); + AReport.Add(''); + AReport.Add('================================================================================'); + AReport.Add(''); + AReport.Add('Analysis of Variance for the ANCOVA Model'); + AReport.Add(' SOURCE Deg.F. SS MS F Prob>F'); + AReport.Add('%10s %10.0f %10.2f %10.2f %10.3f %10.4f', ['Explained', df1, SSGroups, MSGroups, F, Prob]); + AReport.Add('%10s %10.0f %10.2f %10.2f', ['Error', df2, SSError, MSError]); + AReport.Add('%10s %10d %10.2f', ['Total', NCases-1, SSTotal]); + AReport.Add(''); + AReport.Add(''); + end; + + // Obtain adjusted means + AdjustMeans(AReport); + + // make comparisons among groups + if multcomp then MultCompare(AReport); + + // Now do regression, eliminating each block to test effects of that term + PrintIt := false; + AReport.Add(''); + AReport.Add('================================================================================'); + AReport.Add(''); + AReport.Add('TEST FOR EACH SOURCE OF VARIANCE - Type III SS'); + AReport.Add(''); + AReport.Add('--------------------------------------------------------------------------'); + AReport.Add(' SOURCE Deg.F. SS MS F Prob>F'); + AReport.Add('--------------------------------------------------------------------------'); + + localReport := TStringList.Create; + try + for i := 1 to NoBlocks - 1 do // covariates, fixed effects, interactions + begin + count := 0; + for j := 1 to NoBlocks-1 do + begin + if j = i then continue; // exclude the factor to be tested + for k := 1 to Block[j-1,4] do // no of vectors in block + begin + col := Block[j-1,2] + k - 1; // count from beginning col. + count := count + 1; + ColNoSelected[count-1] := col; + IndepIndex[count-1] := count; + RowLabels[count-1] := OS3MainFrm.DataGrid.Cells[col,0]; + end; + end; // get next block of vectors for factors to be included + count := count + 1; + noind := count - 1; + ColNoSelected[count-1] := DepColNo; + IndepIndex[count-1] := count; + RowLabels[count-1] := OS3MainFrm.DataGrid.Cells[DepColNo,0]; + Correlations(count,ColNoSelected,Cormat,Means,Variances,StdDevs,errorcode,NCases); + + // Get regression + SetLength(BStdErrs, noind+1); + SetLength(BTtests, noind+1); + localReport.Add(Blocklabel[i-1]); + localReport.Add(''); + MReg( + noind, ColNoSelected, DepColNo, RowLabels, Means, Variances, StdDevs, + BWeights, BetaWeights, BStdErrs, BTtests, tProbs, R2, StdErrEst, NCases, + errorcode, false, localReport + ); + localReport.Add(''); + + df1 := Block[i-1,4]; + SSGroups := (FullR2 - R2)* SSTotal; + SSGrpTot := SSGrpTot + SSGroups; + MSGroups := SSGroups / df1; + F := MSGroups / MSError; + Prob := probf(F,df1,df2); + + AReport.Add('%10s %10.0f %10.2f %10.2f %10.3g %10.4f', [BlockLabel[i-1], df1, SSGroups, MSGroups, F, Prob]); + end; // get next Block to eliminate + + AReport.Add(''); + AReport.Add('----------------------------------------------------------------------'); + AReport.Add('%10s %10.0f %10.2f %10.2f', ['ERROR', df2, SSError, MSError]); + AReport.Add('----------------------------------------------------------------------'); + AReport.Add('%10s %10d %10.2f', ['TOTAL', NCases-1, SSTotal]); + + AReport.Add(''); + AReport.AddStrings(localReport); + finally + localReport.Free; + end; + + { + df1 := NoCovs; + SSGroups := SSExplained - SSGrpTot; + MSGroups := SSGroups / df1; + F := MSGroups / MSError; + Prob := probf(F,df1,df2); + outline := format('%10s %10.0f %10.2f %10.2f %10.3f %10.4f', + ['Covariates',df1,SSGroups,MSGroups,F,Prob]); + OutputFrm.RichEdit.Lines.Add(outline); + + outline := format('%10s %10.0f %10.2f %10.2f', + ['Error',df2,SSError,MSError]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('%10s %10d %10.2f', + ['Total',NCases-1,SSTotal]); + OutputFrm.RichEdit.Lines.Add(outline); + OutPutFrm.RichEdit.Lines.Add(''); +} + tProbs := nil; + BTTests := nil; + BStdErrs := nil; + + {$IFDEF ANCOVA_DEBUG} + DebugLn('EXIT EntryOpt1'); + {$ENDIF} +end; + +procedure TANCOVAfrm.GenCovInteracts; +var + i, j, l, m, vect1col, vect2col, col: integer; + value: double; + labelstr, cell1, cell2: string; + startcol, endcol, novectors, oldnovars: integer; + lastblock, firstblock: integer; +begin + col := NoVariables; + oldnovars := NoVariables; + novectors := 0; + NoTestVecs := 0; + startcol := Block[NoBlocks-1,3] + 1; + lastblock := NoBlocks; + firstblock := NoCovs + 1; + + // product vectors for each covariate + for i := 1 to NoCovs do + begin + vect1col := Block[i-1,2]; + for j := firstblock to lastblock do + begin + for l := 1 to Block[j-1,4] do + begin + vect2col := Block[j-1,2] + l - 1; // first vector col. of B + col := col + 1; + novectors := novectors + 1; + NoTestVecs := NoTestVecs + 1; + + DictionaryFrm.NewVar(col); + labelstr := OS3MainFrm.DataGrid.Cells[vect1col,0] + 'x'; + labelstr := labelstr + OS3MainFrm.DataGrid.Cells[vect2col,0]; + OS3MainFrm.DataGrid.Cells[col,0] := labelstr; + DictionaryFrm.DictGrid.Cells[1,col] := labelstr; + for m := 1 to NoCases do + begin + if not GoodRecord(m,NoSelected,ColNoSelected) then Continue; + cell1 := Trim(OS3MainFrm.DataGrid.Cells[vect1col,m]); + cell2 := Trim(OS3MainFrm.DataGrid.Cells[vect2col,m]); + value := StrToFloat(cell1) * StrToFloat(cell2); + OS3MainFrm.DataGrid.Cells[col,m] := FloatToStr(value); + end; // next case m + end; // next l vector + end; // next fixed effects factor j and interactions + end; // next covariate i + + endcol := col; // last grid column containing two-way interaction vectors + NoBlocks := NoBlocks + 1; + Block[NoBlocks-1,0] := 0; // zeroes for interactions + Block[NoBlocks-1,1] := 0; // zeroes for interactions + Block[NoBlocks-1,2] := startcol; // grid start col for 2-way interactions + Block[NoBlocks-1,3] := endcol; // grid end col for 2-way interactions + Block[NoBlocks-1,4] := novectors; // no. of vectors for 2-way interaction + BlockLabel[NoBlocks-1] := BlockLabel[i-1] + 'xFixed'; + NoVariables := oldnovars + novectors; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); +end; + +procedure TANCOVAfrm.AdjustMeans(AReport: TStrings); +var + sum : double; + GrpCovMeans : DblDyneMat; + AdjMeans : DblDyneVec; + Intercepts : DblDyneVec; + i, j, k, col, grp, nogrps : integer; + value : double; + Labels : StrDyneVec; + noingrp : IntDyneVec; + XValue : DblDyneVec; + maxmean : double; + cell1 : string; +begin + SetLength(GrpCovMeans,noind,noind); + SetLength(AdjMeans,noind); + SetLength(Intercepts,noind); + SetLength(Labels,noind); + SetLength(noingrp,noind); + SetLength(XValue,noind); + + // get means for groups and covariates + for j := 1 to NoFixed do // for each fixed variable + begin + nogrps := maxgrp[j-1] - mingrp[j-1] + 1; + maxmean := 0.0; + for i := 1 to nogrps do + begin + XValue[i-1] := i; + noingrp[i-1] := 0; + for k := 1 to NoCovs do GrpCovMeans[i-1,k-1] := 0.0; + end; + for i := 1 to nogrps do AdjMeans[i-1] := 0.0; + for i := 1 to NoCases do + begin + cell1 := Trim(OS3MainFrm.DataGrid.Cells[FixedCols[j-1],i]); + if cell1 = '' then continue; + grp := round(StrToFloat(cell1)); + grp := grp - mingrp[j-1] + 1; + noingrp[grp-1] := noingrp[grp-1] + 1; + for k := 1 to NoCovs do + begin + col := CovCols[k-1]; + cell1 := Trim(OS3MainFrm.DataGrid.Cells[col,i]); + if cell1 = '' then continue; + value := StrToFloat(cell1); + GrpCovMeans[grp-1,k-1] := GrpCovMeans[grp-1,k-1] + value; + end; + cell1 := Trim(OS3MainFrm.DataGrid.Cells[DepColNo,i]); + if cell1 = '' then continue; + value := StrToFloat(cell1); + AdjMeans[grp-1] := AdjMeans[grp-1] + value; + end; // next case i + + SetLength(GraphFrm.Ypoints,1,nogrps); + SetLength(GraphFrm.Xpoints,1,nogrps); + for k := 1 to nogrps do + begin + AdjMeans[k-1] := AdjMeans[k-1] / noingrp[k-1]; + GraphFrm.Ypoints[0,k-1] := AdjMeans[k-1]; + GraphFrm.Xpoints[0,k-1] := k; + if AdjMeans[k-1] > maxmean then maxmean := AdjMeans[k-1]; + for i := 1 to NoCovs do + begin + GrpCovMeans[k-1,i-1] := GrpCovMeans[k-1,i-1] / noingrp[k-1]; + end; + end; + + // print unadjusted means + AReport.Add('================================================================================'); + AReport.Add(''); + AReport.Add('Unadjusted Group Means for Group Variables ' + OS3MainFrm.DataGrid.Cells[FixedCols[j-1] ,0]); + DynVectorPrint(AdjMeans,nogrps,'Means',Labels,NCases, AReport); + AReport.Add(''); + + // plot group means if requested + if plot then + begin + GraphFrm.nosets := 1; + GraphFrm.nbars := nogrps; + GraphFrm.Heading := 'Unadjusted Means'; + GraphFrm.XTitle := 'GROUP'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := 2; // 3d Vertical Bar Chart + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; + // get intercepts for group equations for this fixed effect variable + sum := 0.0; + for k := 1 to nogrps - 1 do // no. vectors is 1 less than no. groups + begin + intercepts[k-1] := constant + BWeights[NoCovs+k-1]; + sum := sum + BWeights[NoCovs+k-1]; + end; + intercepts[nogrps-1] := constant - sum; + + // get adjusted means + for k := 1 to nogrps do + begin + sum := 0.0; + for i := 1 to NoCovs do + sum := sum + BWeights[i-1] * (GrpCovMeans[k-1,i-1]-Means[i-1]); + AdjMeans[k-1] := AdjMeans[k-1] - sum; + GraphFrm.Ypoints[0,k-1] := AdjMeans[k-1]; + Labels[k-1] := 'Group ' + IntToStr(k); + end; + + // plot group means if requested + if plot then + begin + GraphFrm.nosets := 1; + GraphFrm.nbars := nogrps; + GraphFrm.Heading := 'Adjusted Means'; + GraphFrm.XTitle := 'GROUP'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := 2; // 3d Vertical Bar Chart + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; + + // print results for intercepts + AReport.Add('================================================================================'); + AReport.Add(''); + AReport.Add('Intercepts for Each Group Regression Equation for Variable: ' + OS3MainFrm.DataGrid.Cells[FixedCols[j-1] ,0]); + DynVectorPrint(Intercepts, nogrps, 'Intercepts', Labels, NCases, AReport); + AReport.Add(''); + + // print adjusted means + AReport.Add('================================================================================'); + AReport.Add(''); + AReport.Add('Adjusted Group Means for Group Variables ' + OS3MainFrm.DataGrid.Cells[FixedCols[j-1] ,0]); + DynVectorPrint(AdjMeans, nogrps, 'Means', Labels, NCases, AReport); + AReport.Add(''); + end; + //OutputFrm.ShowModal; + //OutputFrm.RichEdit.Clear; + XValue := nil; + noingrp := nil; + Labels := nil; + intercepts := nil; + AdjMeans := nil; + GrpCovMeans := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +procedure TANCOVAfrm.MultCompare(AReport: TStrings); +var + i, j, size : integer; + covmat : DblDyneMat; + title : string; + Labels : StrDyneVec; + sum : double; + df1, df2, F, Prob : double; + +begin + SetLength(covmat,noind,noind); + SetLength(Labels,noind); + + AReport.Add('================================================================================'); + AReport.Add(''); + AReport.Add('Multiple Comparisons Among Group Means'); + AReport.Add(''); + SVDInverse(IndMat,noind); + size := noind - NoCovs; + title := 'Inverse of Independents Matrix'; + for i := 1 to noind do Labels[i-1] := 'Group ' + IntToStr(i); + for i := 1 to noind-NoCovs do + for j := 1 to noind-NoCovs do + covmat[i-1,j-1] := sqr(StdErrEst) * IndMat[NoCovs+i-1,NoCovs+j-1] / + (Variances[NoCovs+j-1] * (NoCases-1)); + for i := 1 to size+1 do Labels[i-1] := 'Group ' + IntToStr(i); + + // augment matrix + for i := 1 to size do + begin + sum := 0.0; + for j := 1 to size do + begin + sum := sum + covmat[i-1,j-1]; + end; + covmat[i-1,size] := -sum; + covmat[size,i-1] := -sum; + end; + + sum := 0.0; + for i := 1 to size do sum := sum + covmat[i-1,size]; + covmat[size,size] := -sum; + if PrintInverseMat.Checked then + begin + AReport.Add('================================================================================'); + AReport.Add(''); + title := 'Augmented Covariance Among Group Vectors'; + for i := 1 to size do Labels[i-1] := 'Group ' + IntToStr(i); + MatPrint(covmat,size+1,size+1,title,Labels,Labels,NoCases, AReport); + end; + + // Now, contrast the b coefficients + // Get last B weight from effect coding as - sum of other B weights + BWeights[noind] := 0.0; + for i := 0 to noind-1 do BWeights[noind] := BWeights[noind] - BWeights[i]; + for i := 1 to size do + begin + for j := i + 1 to size + 1 do + begin + df1 := 1.0; + df2 := NoCases - noind - 1; + F := sqr(BWeights[NoCovs+i-1] - BWeights[NoCovs+j-1]); + F := F / (covmat[i-1,i-1] + covmat[j-1,j-1] - (covmat[i-1,j-1] + covmat[j-1,i-1])); + Prob := probf(F,df1,df2); + AReport.Add('Comparison of Group %3d with Group %3d', [i,j]); + AReport.Add('F = %10.3f, probability = %5.3f with degrees of freedom %5.0f and %5.0f', [F, Prob, df1, df2]); + end; + end; + AReport.Add(''); + Labels := nil; + covmat := nil; +end; + +procedure TANCOVAfrm.UpdateBtnStates; +var + lSelected: Boolean; + i: Integer; +begin + DepIn.Enabled := (VarList.ItemIndex > -1) and (DepVar.Text = ''); + DepOut.Enabled := (DepVar.Text <> ''); + + lSelected := false; + for i := 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + FixedIn.Enabled := lSelected; + CovIn.Enabled := lSelected; + + lSelected := false; + for i := 0 to FixedList.Items.Count-1 do + if FixedList.Selected[i] then + begin + lSelected := true; + break; + end; + FixedOut.Enabled := lSelected; + + lSelected := false; + for i := 0 to CovList.Items.Count-1 do + if CovList.Selected[i] then + begin + lSelected := true; + break; + end; + CovOut.Enabled := lSelected; +end; + +procedure TANCOVAfrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I ancovaunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/axsanovaunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/axsanovaunit.lfm new file mode 100644 index 000000000..a4dfdd199 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/axsanovaunit.lfm @@ -0,0 +1,313 @@ +object AxSAnovaFrm: TAxSAnovaFrm + Left = 629 + Height = 360 + Top = 278 + Width = 471 + AutoSize = True + Caption = 'Treatments by Subjects ANOVA (AxS)' + ClientHeight = 360 + ClientWidth = 471 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 51 + Top = 260 + Width = 282 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + Caption = 'Option' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 16 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 31 + ClientWidth = 278 + TabOrder = 1 + object PlotChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 102 + Caption = 'Plot Cell Means' + TabOrder = 0 + end + object PosthocChk: TCheckBox + Left = 130 + Height = 19 + Top = 6 + Width = 136 + BorderSpacing.Left = 8 + Caption = 'Posthoc Comparisons' + TabOrder = 1 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 258 + Height = 25 + Top = 327 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 320 + Height = 25 + Top = 327 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 404 + Height = 25 + Top = 327 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 5 + end + object HelpBtn: TButton + Tag = 106 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 199 + Height = 25 + Top = 327 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 2 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 311 + Width = 471 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 240 + Top = 8 + Width = 455 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 240 + ClientWidth = 455 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 100 + Caption = 'Available Variables:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + Left = 249 + Height = 15 + Top = 25 + Width = 77 + BorderSpacing.Left = 8 + Caption = 'Group Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = RepInBtn + Left = 249 + Height = 15 + Top = 106 + Width = 102 + BorderSpacing.Left = 8 + BorderSpacing.Top = 5 + Caption = 'Repeated Measures' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepInBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 223 + Top = 17 + Width = 205 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object DepInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 213 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInBtnClick + Spacing = 0 + TabOrder = 1 + end + object DepOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepInBtn + AnchorSideTop.Side = asrBottom + Left = 213 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object RepInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepOutBtn + AnchorSideTop.Side = asrBottom + Left = 213 + Height = 28 + Top = 101 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = RepInBtnClick + Spacing = 0 + TabOrder = 4 + end + object RepOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = RepInBtn + AnchorSideTop.Side = asrBottom + Left = 213 + Height = 28 + Top = 133 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = RepOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object GrpVar: TEdit + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 249 + Height = 23 + Top = 40 + Width = 206 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + OnChange = GrpVarChange + ReadOnly = True + TabOrder = 3 + Text = 'GrpVar' + end + object RepList: TListBox + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 249 + Height = 117 + Top = 123 + Width = 206 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 6 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/axsanovaunit.pas b/applications/lazstats/source/forms/analysis/comparisons/axsanovaunit.pas new file mode 100644 index 000000000..b8955cf98 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/axsanovaunit.pas @@ -0,0 +1,1033 @@ +// Use file "abrdata.laz" for testing + +unit AxSANOVAUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, FunctionsLib, GraphLib, Globals, + DataProcs, ContextHelpUnit; + +type + + { TAxSAnovaFrm } + + TAxSAnovaFrm = class(TForm) + Bevel1: TBevel; + Panel1: TPanel; + PosthocChk: TCheckBox; + DepInBtn: TBitBtn; + DepOutBtn: TBitBtn; + HelpBtn: TButton; + RepInBtn: TBitBtn; + RepOutBtn: TBitBtn; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + PlotChk: TCheckBox; + GrpVar: TEdit; + GroupBox1: TGroupBox; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + RepList: TListBox; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure DepInBtnClick(Sender: TObject); + procedure DepOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure GrpVarChange(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure RepInBtnClick(Sender: TObject); + procedure RepOutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + + private + { private declarations } + FAutoSized: Boolean; + procedure PostHocTests(NoSelected: integer; MSerr: double; dferr: integer; + Count: integer; ColMeans: DblDyneVec; AReport: TStrings); + procedure UpdateBtnStates; + + // wp: replace the following methods by those in ANOVATestUnit? + procedure Tukey( + error_ms : double; { mean squared for residual } + error_df : double; { deg. freedom for residual } + value : double; { size of smallest group } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { no. of cases in a group } + min_grp : integer; { minimum group code } + max_grp : integer; { maximum group code } + AReport : TStrings); + + procedure ScheffeTest( + error_ms : double; { mean squared residual } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { count of cases in a group } + min_grp : integer; { code of first group } + max_grp : integer; { code of last group } + total_n : double; { total number of cases } + AReport : TStrings); + + procedure Newman_Keuls( + error_ms : double; { residual mean squared } + error_df : double; { deg. freedom for error } + value : double; { number in smallest group } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { count of cases in a group } + min_grp : integer; { lowest group code } + max_grp : integer; { largest group code } + AReport : TStrings); + + procedure Tukey_Kramer( + error_ms : double; { residual mean squared } + error_df : double; { deg. freedom for error } + value : double; { number in smallest group } + group_total : DblDyneVec; { sum of scores in group } + group_count : DblDyneVec; { number of caes in group } + min_grp : integer; { code of lowest group } + max_grp : integer; { code of highst group } + AReport : TStrings); + + procedure TukeyBTest( + ErrorMS : double; { within groups error } + ErrorDF : double; { degrees of freedom within } + group_total : DblDyneVec; { vector of group sums } + group_count : DblDyneVec; { vector of group n's } + min_grp : integer; { smallest group code } + max_grp : integer; { largest group code } + groupsize : double; { size of groups (all equal) } + AReport : TStrings); + + public + { public declarations } + end; + +var + AxSAnovaFrm: TAxSAnovaFrm; + +implementation + +uses + Math, + OutputUnit; + +{ TAxSAnovaFrm } + +procedure TAxSAnovaFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Items.Clear; + RepList.Items.Clear; + GrpVar.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + PlotChk.Checked := false; + UpdateBtnStates; +end; + +procedure TAxSAnovaFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinHeight := Height; + Constraints.MinWidth := Width; + + FAutoSized := true; +end; + +procedure TAxSAnovaFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TAxSAnovaFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TAxSAnovaFrm.GrpVarChange(Sender: TObject); +begin + UpdateBtnStates; +end; + +procedure TAxSAnovaFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TAxSAnovaFrm.RepInBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if (VarList.Selected[i]) then + begin + RepList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + VarList.ItemIndex := -1; + UpdateBtnStates; +end; + +procedure TAxSAnovaFrm.RepOutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < RepList.Items.Count do + begin + if RepList.Selected[i] then + begin + VarList.Items.Add(RepList.Items[i]); + RepList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + VarList.ItemIndex := -1; + RepList.ItemIndex := -1; + UpdateBtnStates; +end; + +procedure TAxSAnovaFrm.DepInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (GrpVar.Text = '') then + begin + GrpVar.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + VarList.ItemIndex := -1; + UpdateBtnStates; +end; + +procedure TAxSAnovaFrm.ComputeBtnClick(Sender: TObject); +var + a1, a2, agrp, i, j, k, v1, totaln, NoSelected, range: integer; + group, col: integer; + p, X, f1, f2, f3, probf1, probf2, probf3, fd1, fd2, TotMean: double; + TotStdDev, den, maxmean: double; + C, StdDev: DblDyneMat; + squaredsumx, sumxsquared, coltot, sumsum: DblDyneVec; + degfree: array[1..8] of integer; + ColNoSelected: IntDyneVec; + ss: array[1..8] of double; + ms: array[1..8] of double; + coeff: array[1..6] of double; + N: IntDyneVec; + value, outline: string; + lReport: TStrings; +begin + if GrpVar.Text = '' then + begin + MessageDlg('Select a variable for between-groups treatment groups', mtError, [mbOK], 0); + exit; + end; + + if RepList.Items.Count < 2 then + begin + MessageDlg('This test requires at least two variables for repeated measurements.', mtError, [mbOK], 0); + exit; + end; + + SetLength(ColNoSelected,NoVariables+1); + NoSelected := 1; + + // Get between subjects group variable + for j := 1 to NoVariables do + if GrpVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then ColNoSelected[0] := j; + v1 := ColNoSelected[0]; //A treatment (group) variable + + //get minimum and maximum group codes for Treatment A + a1 := 1000; //atoi(MainForm.Grid.Cells[v1][1].c_str()); + a2 := 0; //a1; + for i := 1 to NoCases do + Begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v1,i]))); + if group < a1 then a1 := group; + if group > a2 then a2 := group; + end; + range := a2 - a1 + 1; + NoSelected := RepList.Items.Count + 1; + k := NoSelected - 1; //Number of B (within subject) treatment levels + + // allocate heap + SetLength(C, range+1, NoSelected+1); + SetLength(N, range+1); + SetLength(squaredsumx, range+1); + SetLength(coltot, NoSelected+1); + SetLength(sumxsquared, range+1); + SetLength(sumsum, range+1); + SetLength(StdDev, range+1, NoSelected+1); + + // initialize arrays + for i := 0 to range-1 do + begin + N[i] := 0; + squaredsumx[i] := 0.0; + sumxsquared[i] := 0.0; + sumsum[i] := 0.0; + for j := 0 to k-1 do + C[i,j] := 0.0; + end; + + for j := 0 to k-1 do + coltot[j] := 0.0; + for i := 0 to range do + for j := 0 to k do + StdDev[i,j] := 0.0; + for i := 1 to 6 do + coeff[i] := 0.0; + for i := 1 to 8 do + degfree[i] := 0; + TotStdDev := 0.0; + TotMean := 0.0; + totaln := 0; + + // Get items selected for repeated measures (B treatments) + for i := 0 to RepList.Items.Count - 1 do + begin + for j := 1 to NoVariables do + if RepList.Items.Strings[i] = OS3MainFrm.DataGrid.Cells[j,0] then + ColNoSelected[i+1] := j; + end; + + //Read data values and get sums and sums of squared values + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + agrp := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v1,i]))); + agrp := agrp - a1 + 1; // offset to one + p := 0.0; + + //Now read the B treatment scores + for j := 1 to k do + begin + col := ColNoSelected[j]; + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); + C[agrp-1,j-1] := C[agrp-1,j-1] + X; + StdDev[agrp-1,j-1] := StdDev[agrp-1,j-1] + (X * X); + coeff[1]:= coeff[1] + X; + p := p + X; + sumxsquared[agrp-1] := sumxsquared[agrp-1] + (X * X); + TotMean := TotMean + X; + TotStdDev := TotStdDev + (X * X); + end; + N[agrp-1] := N[agrp-1] + 1; + squaredsumx[agrp-1] := squaredsumx[agrp-1] + (p * p); + sumsum[agrp-1] := sumsum[agrp-1] + p; + end; // next case + + // Obtain sums of squares for std. dev.s of B treatments + for i := 1 to k do // column (B treatments) + for j := 1 to range do // group of A treatments + StdDev[range,i-1] := StdDev[range,i-1] + StdDev[j-1,i-1]; + + // Obtain sums of squares for std. dev.s of A treatments + for i := 1 to range do + for j := 1 to k do + StdDev[i-1,k] := StdDev[i-1,k] + StdDev[i-1,j-1]; + + // Obtain cell standard deviations + for i := 1 to range do // rows + begin + for j := 1 to k do // columns + begin + StdDev[i-1,j-1] := StdDev[i-1,j-1] - ((C[i-1,j-1] * C[i-1,j-1]) / (N[i-1])); + StdDev[i-1,j-1] := StdDev[i-1,j-1] / (N[i-1]-1); + StdDev[i-1,j-1] := sqrt(StdDev[i-1,j-1]); + end; + end; + + // Obtain A treatment group standard deviations + for i := 1 to range do + begin + StdDev[i-1,k] := StdDev[i-1,k] - ((sumsum[i-1] * sumsum[i-1]) / (k * N[i-1])); + StdDev[i-1,k] := StdDev[i-1,k] / (k * N[i-1] - 1); + StdDev[i-1,k] := sqrt(StdDev[i-1,k]); + end; + + // Obtain coefficients for the sums of squares + for i := 1 to range do + begin + coeff[2] := coeff[2] + sumxsquared[i-1]; + coeff[3] := coeff[3] + ((sumsum[i-1] * (sumsum[i-1]) / ((N[i-1] * k)))); + coeff[6] := coeff[6] + squaredsumx[i-1]; + totaln := totaln + N[i-1]; + end; + coeff[1] := (coeff[1] * coeff[1]) / (totaln * k); + den := k; + coeff[6] := coeff[6] / den; + for j := 1 to k do + begin + coltot[j-1] := 0.0; + for i := 1 to range do + begin + coltot[j-1] := coltot[j-1] + C[i-1,j-1]; + coeff[5] := coeff[5] + ((C[i-1,j-1] * C[i-1,j-1]) / N[i-1]); + end; + coeff[4] := coeff[4] + (coltot[j-1] * coltot[j-1]); + end; + den := totaln; + coeff[4] := coeff[4] / den; + + // Obtain B treatment group standard deviations + for j := 1 to k do + begin + StdDev[range,j-1] := StdDev[range,j-1] - ((coltot[j-1] * coltot[j-1]) / totaln); + StdDev[range,j-1] := StdDev[range,j-1] / (totaln-1); + StdDev[range,j-1] := sqrt(StdDev[range,j-1]); + end; + + // Calculate degrees of freedom for the mean squares + degfree[1] := totaln - 1; // Between subjects degrees freedom + degfree[2] := a2 - a1; // between groups degrees of freedom + degfree[3] := totaln - (a2 - a1 + 1);// subjects within groups deg. frd. + degfree[4] := totaln * (k - 1); // within subjects degrees of freedom + degfree[5] := k - 1; // B treatments degrees of freedom + degfree[6] := degfree[2] * degfree[5]; // A x B interaction degrees of frd. + degfree[7] := degfree[3] * degfree[5]; // B x Subjects within groups d.f. + degfree[8] := k * totaln - 1; // total degrees of freedom + + // Calculate the sums of squares + ss[1] := coeff[6] - coeff[1]; + ss[2] := coeff[3] - coeff[1]; + ss[3] := coeff[6] - coeff[3]; + ss[4] := coeff[2] - coeff[6]; + ss[5] := coeff[4] - coeff[1]; + ss[6] := coeff[5] - coeff[3] - coeff[4] + coeff[1]; + ss[7] := coeff[2] - coeff[5] - coeff[6] + coeff[3]; + ss[8] := coeff[2] - coeff[1]; + + // Calculate the mean squares + for i := 1 to 8 do + ms[i] := ss[i] / degfree[i]; + + // Calculate the f-tests for effects A, B and interaction + if (ms[3] > 0.0) then f1 := ms[2] / ms[3] else f1 := 1000.0; + if (ms[7] > 0.0) then + begin + f2 := ms[5] / ms[7]; + f3 := ms[6] / ms[7]; + end else + begin + f2 := 1000.0; + f3 := 1000.0; + end; + + //Now, report results + lReport := TStringList.Create; + try + lReport.Add('ANOVA With One Between Subjects and One Within Subjects Treatments'); + lReport.Add(''); + lReport.Add('------------------------------------------------------------------'); + lReport.Add('Source df SS MS F Prob.'); + lReport.Add('------------------------------------------------------------------'); + + fd1 := degfree[2]; + fd2 := degfree[3]; + probf1 := probf(f1, fd1, fd2); + fd1 := degfree[5]; + fd2 := degfree[7]; + probf2 := probf(f2, fd1, fd2); + fd1 := degfree[6]; + fd2 := degfree[7]; + probf3 := probf(f3, fd1, fd2); + lReport.Add('Between %5d %10.3f', [degfree[1], ss[1]]); + lReport.Add(' Groups (A) %5d %10.3f %10.3f %10.3f %6.4f', [degfree[2], ss[2], ms[2], f1, probf1]); + lReport.Add(' Subjects w.g.%5d %10.3f %10.3f', [degfree[3], ss[3], ms[3]]); + lReport.Add(''); + lReport.Add('Within Subjects %5d %10.3f', [degfree[4], ss[4]]); + lReport.Add(' B Treatments %5d %10.3f %10.3f %10.3f %6.4f', [degfree[5], ss[5], ms[5], f2, probf2]); + lReport.Add(' A X B inter. %5d %10.3f %10.3f %10.3f %6.4f', [degfree[6], ss[6], ms[6], f3, probf3]); + lReport.Add(' B X S w.g. %5d %10.3f %10.3f', [degfree[7], ss[7], ms[7]]); + lReport.Add(''); + lReport.Add('TOTAL %5d %10.3f', [degfree[8], ss[8]]); + lReport.Add('------------------------------------------------------------------'); + + //Calculate and print means + lReport.Add('Means'); + outline := 'TRT. '; + for i := 1 to k do + begin + value := Format('B%3d ', [i]); + outline := outline + value; + end; + outline := outline + 'TOTAL'; + lReport.Add(outline); + lReport.Add(' A '); + for i := 1 to range do + begin + for j := 1 to k do + C[i-1,j-1] := C[i-1,j-1] / N[i-1]; //mean of each B treatment within A treatment + sumsum[i-1] := sumsum[i-1] / (N[i-1] * k); //means in A treatment accross B treatments + end; + for j := 1 to k do + coltot[j-1] := coltot[j-1] / totaln; + TotStdDev := TotStdDev - ((TotMean * TotMean) / (k * totaln)); + TotStdDev := TotStdDev / (k * totaln - 1); + TotStdDev := sqrt(TotStdDev); + TotMean := TotMean / (k * totaln); + for i := 1 to range do + begin + outline := Format('%3d ', [i+a1-1]); + for j := 1 to k do + begin + value := format('%7.3f', [C[i-1,j-1]]); + outline := outline + value; + end; + value := Format('%7.3f', [sumsum[i-1]]); + outline := outline + value; + lReport.Add(outline); + end; + outline := 'TOTAL'; + for j := 1 to k do + begin + value := Format('%7.3f', [coltot[j-1]]); + outline := outline + value; + end; + value := Format('%7.3f', [TotMean]); + outline := outline + value; + lReport.Add(outline); + + // Print standard deviations + lReport.Add(''); + lReport.Add('Standard Deviations'); + outline := 'TRT. '; + for i := 1 to k do + begin + value := Format('B%3d ', [i]); + outline := outline + value; + end; + outline := outline + 'TOTAL'; + lReport.Add(outline); + lReport.Add(' A '); + for i := 1 to range do + begin + outline := Format('%3d ', [i+a1-1]); + for j := 1 to k do + begin + value := Format('%7.3f', [StdDev[i-1,j-1]]); + outline := outline + value; + end; + value := Format('%7.3f', [StdDev[i-1,k]]); + outline := outline + value; + lReport.Add(outline); + end; + outline := 'TOTAL'; + for j := 1 to k do + begin + value := Format('%7.3f', [StdDev[range,j-1]]); + outline := outline + value; + end; + value := Format('%7.3f', [TotStdDev]); + outline := outline + value; + lReport.Add(outline); + + if PosthocChk.Checked then + begin + // Do tests for the A (between groups) + lReport.Add(''); + lReport.Add('==============================================================='); + lReport.Add(''); + lReport.Add('COMPARISONS FOR THE BETWEEN-GROUP MEANS'); + PostHocTests(range, MS[1], degfree[1], range, sumsum, lReport); + lReport.Add(''); + + // Do tests for the B (repeated measures) + lReport.Add(''); + lReport.Add('==============================================================='); + lReport.Add(''); + lReport.Add('COMPARISONS FOR THE REPEATED-MEASURES MEANS'); + PostHocTests(k, ms[4], degfree[4], NoCases, coltot, lReport); + end; + + DisplayReport(lReport); + + finally + lReport.Free; + end; + + if PlotChk.Checked then // PlotMeans(C,range,k,this) + begin + maxmean := 0.0; + SetLength(GraphFrm.Ypoints,range,k); + SetLength(GraphFrm.Xpoints,1,k); + for i := 1 to range do + begin + GraphFrm.SetLabels[i] := 'A ' + IntToStr(i); + for j := 1 to k do + begin + GraphFrm.Ypoints[i-1,j-1] := C[i-1,j-1]; + if C[i-1,j-1] > maxmean then + maxmean := C[i-1,j-1]; + end; + end; + + for j := 1 to k do + begin + coltot[j-1] := j; + GraphFrm.Xpoints[0,j-1] := j; + end; + + GraphFrm.nosets := range; + GraphFrm.nbars := k; + GraphFrm.Heading := 'TREATMENTS X SUBJECT REPLICATIONS ANOVA'; + GraphFrm.XTitle := 'WITHIN (B) TREATMENT GROUP'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.GraphType := 2; // 3d Vertical Bar Chart + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; + + // Clean up + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + StdDev := nil; + sumsum := nil; + sumxsquared := nil; + coltot := nil; + squaredsumx := nil; + N := nil; + C := nil; + ColNoSelected := nil; +end; + +procedure TAxSAnovaFrm.DepOutBtnClick(Sender: TObject); +begin + if GrpVar.Text <> '' then + begin + VarList.Items.Add(GrpVar.Text); + GrpVar.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TAxSAnovaFrm.PostHocTests(NoSelected: Integer; MSerr: double; + dferr: integer; Count: integer; ColMeans: DblDyneVec; AReport: TStrings); +var + group_total: DblDyneVec; + group_count: DblDyneVec; + i, mingrp: integer; +begin + SetLength(group_total,NoSelected); + SetLength(group_count,NoSelected); + for i := 0 to NoSelected - 1 do + begin + group_count[i] := double(Count); + group_total[i] := double(Count) * ColMeans[i]; + end; + + mingrp := 1; + Tukey(MSerr, dferr, Count, group_total, group_count, mingrp, NoSelected, AReport); + Tukey_Kramer(MSerr, dferr, Count, group_total, group_count, mingrp, NoSelected, AReport); + TukeyBTest(MSerr, dferr, group_total, group_count, mingrp,NoSelected, Count, AReport); + ScheffeTest(MSerr, group_total, group_count, mingrp, NoSelected, Count*NoSelected, AReport); + Newman_Keuls(MSerr, dferr, Count, group_total, group_count, mingrp, NoSelected, AReport); +end; + +procedure TAxSAnovaFrm.Tukey( + error_ms : double; { mean squared for residual } + error_df : double; { deg. freedom for residual } + value : double; { size of smallest group } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { no. of cases in a group } + min_grp : integer; { minimum group code } + max_grp : integer; { maximum group code } + AReport : TStrings); +var + sig: boolean; + divisor: double; + df1: integer; + alpha: double; + contrast, mean1, mean2: double; + q_stat: double; + i,j: integer; + outline: string; +begin + alpha := DEFAULT_ALPHA_LEVEL; + AReport.Add('---------------------------------------------------------------'); + AReport.Add(' Tukey HSD Test for Differences Between Means'); + AReport.Add(' alpha selected = %.2f', [alpha]); + AReport.Add(''); + AReport.Add('Groups Difference Statistic Probability Significant?'); + AReport.Add('---------------------------------------------------------------'); + + divisor := sqrt(error_ms / value); + for i := min_grp to max_grp - 1 do + for j := i + 1 to max_grp do + begin + outline := Format('%2d - %2d ', [i,j]); + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + contrast := mean1 - mean2; + outline := outline + Format('%7.3f q = ', [contrast]); + contrast := abs(contrast / divisor) ; + outline := outline + Format('%6.3f ', [contrast]); + df1 := max_grp - min_grp + 1; + q_stat := STUDENT(contrast, error_df, df1); + outline := outline + Format(' %6.4f', [q_stat]); + if alpha >= q_stat then sig := TRUE else sig := FALSE; + if sig = TRUE then + outline := outline + ' YES ' + else + outline := outline + ' NO'; + AReport.Add(outline); + end; + + AReport.Add('---------------------------------------------------------------'); +end; + +procedure TAxSAnovaFrm.ScheffeTest( + error_ms : double; { mean squared residual } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { count of cases in a group } + min_grp : integer; { code of first group } + max_grp : integer; { code of last group } + total_n : double; { total number of cases } + AReport : TStrings); +var + statistic, stat_var, stat_sd: double; + mean1, mean2, alpha, difference, prob_scheffe, f_prob, df1, df2: double; + outline: string; + i, j: integer; +begin + alpha := DEFAULT_ALPHA_LEVEL; + AReport.Add(''); + AReport.Add('----------------------------------------------------------------'); + AReport.Add(' Scheffe contrasts among pairs of means.'); + AReport.Add(' alpha selected = %.2f', [alpha]); + AReport.Add(''); + AReport.Add('Group vs Group Difference Scheffe Critical Significant?'); + AReport.Add(' Statistic Value'); + AReport.Add('----------------------------------------------------------------'); + + alpha := 1.0 - alpha ; + for i:= min_grp to max_grp - 1 do + for j := i + 1 to max_grp do + begin + outline := Format('%2d %2d ', [i,j]); + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + difference := mean1 - mean2; + outline := outline + Format('%8.2f ', [difference]); + stat_var := error_ms * ( 1.0 / group_count[i-1] + 1.0 / group_count[j-1]); + stat_sd := sqrt(stat_var); + statistic := abs(difference / stat_sd); + outline := outline + Format('%8.2f ', [statistic]); + df1 := max_grp - min_grp; + df2 := total_n - df1 + 1; + f_prob := fpercentpoint(alpha, round(df1), round(df2) ); + prob_scheffe := sqrt(df1 * f_prob); + outline := outline + Format('%8.3f ', [prob_scheffe]); + if statistic > prob_scheffe then + outline := outline + 'YES' + else + outline := outline + 'NO'; + AReport.Add(outline); + end; + + AReport.Add('----------------------------------------------------------------'); +end; + +procedure TAxSAnovaFrm.Newman_Keuls( + error_ms : double; { residual mean squared } + error_df : double; { deg. freedom for error } + value : double; { number in smallest group } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { count of cases in a group } + min_grp : integer; { lowest group code } + max_grp : integer; { largest group code } + AReport : TStrings); +var + i, j: integer; + temp1, temp2: double; + groupno: IntDyneVec; + alpha: double; + contrast, mean1, mean2: double; + q_stat: double; + divisor: double; + tempno: integer; + df1: integer; + sig: boolean; + outline: string; +begin + SetLength(groupno, max_grp - min_grp + 1); + + for i := min_grp to max_grp do + groupno[i-1] := i; + + for i := min_grp to max_grp - 1 do + begin + for j := i + 1 to max_grp do + begin + if group_total[i-1] / group_count[i-1] > group_total[j-1] / group_count[j-1] then + begin + temp1 := group_total[i-1]; + temp2 := group_count[i-1]; + tempno := groupno[i-1]; + group_total[i-1] := group_total[j-1]; + group_count[i-1] := group_count[j-1]; + groupno[i-1] := groupno[j-1]; + group_total[j-1] := temp1; + group_count[j-1] := temp2; + groupno[j-1] := tempno; + end; + end; + end; + + alpha := DEFAULT_ALPHA_LEVEL; + AReport.Add(''); + AReport.Add('----------------------------------------------------------------------'); + AReport.Add(' Neuman-Keuls Test for Contrasts on Ordered Means'); + AReport.Add(' alpha selected = %.2f', [alpha]); + AReport.Add(''); + AReport.Add('Group Mean'); + for i := 1 to max_grp do + AReport.Add('%3d %10.3f', [groupno[i-1], group_total[i-1] / group_count[i-1]]); + AReport.Add(''); + AReport.Add('Groups Difference Statistic d.f. Probability Significant?'); + AReport.Add('----------------------------------------------------------------------'); + + divisor := sqrt(error_ms / value); + for i := min_grp to max_grp - 1 do + begin + for j := i + 1 to max_grp do + begin + outline := Format('%2d - %2d ', [groupno[i-1], groupno[j-1]]); + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + contrast := mean1 - mean2; + outline := outline + Format('%7.3f q = ', [contrast]); + contrast := abs(contrast / divisor ); + df1 := j - i + 1; + outline := outline + Format('%6.3f %2d %3.0f ', [contrast, df1, error_df]); + q_stat := STUDENT(contrast, error_df, df1); + outline := outline + Format(' %6.4f', [q_stat]); + sig := alpha > q_stat; + if sig then + outline := outline + ' YES' + else + outline := outline + ' NO'; + AReport.Add(outline); + end; + end; + + AReport.Add('----------------------------------------------------------------------'); + groupno := nil; +end; + +procedure TAxSAnovaFrm.Tukey_Kramer( + error_ms : double; { residual mean squared } + error_df : double; { deg. freedom for error } + value : double; { number in smallest group } + group_total : DblDyneVec; { sum of scores in group } + group_count : DblDyneVec; { number of caes in group } + min_grp : integer; { code of lowest group } + max_grp : integer; { code of highst group } + AReport : TStrings); +var + sig: boolean; + divisor: double; + df1: integer; + alpha: double; + contrast, mean1, mean2: double; + q_stat: double; + outline: string; + i, j: integer; +begin + alpha := DEFAULT_ALPHA_LEVEL; + AReport.Add(''); + AReport.Add('---------------------------------------------------------------'); + AReport.Add(' Tukey-Kramer Test for Differences Between Means'); + AReport.Add(' alpha selected = %.2f', [alpha]); + AReport.Add(''); + AReport.Add('Groups Difference Statistic Probability Significant?'); + AReport.Add('---------------------------------------------------------------'); + + for i := min_grp to max_grp - 1 do + for j := i + 1 to max_grp do + begin + outline := Format('%2d - %2d ', [i, j]); + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + contrast := mean1 - mean2; + outline := outline + Format('%7.3f q = ', [contrast]); + divisor := sqrt(error_ms * ((1.0/group_count[i-1] + 1.0/group_count[j-1]) / 2)); + contrast := abs(contrast / divisor) ; + outline := outline + Format('%6.3f ', [Contrast]); + df1 := max_grp - min_grp + 1; + q_stat := STUDENT(contrast, error_df, df1); + outline := outline + Format(' %6.4f', [q_stat]); + sig := alpha >= q_stat; + if sig then + outline := outline + ' YES ' + else + outline := outline + ' NO'; + AReport.Add(outline); + end; + + AReport.Add('---------------------------------------------------------------'); +end; + +procedure TAxSAnovaFrm.TukeyBTest( + ErrorMS : double; // within groups error + ErrorDF : double; // degrees of freedom within + group_total : DblDyneVec; // vector of group sums + group_count : DblDyneVec; // vector of group n's + min_grp : integer; // smallest group code + max_grp : integer; // largest group code + groupsize : double; // size of groups (all equal) + AReport : TStrings); +var + alpha : double; + outline: string; + i, j: integer; + df1: double; + qstat: double; + tstat: double; + groupno: IntDyneVec; + temp1, temp2: double; + tempno: integer; + NoGrps: integer; + contrast: double; + mean1, mean2: double; + sig: string[6]; + groups: double; + divisor: double; +begin + SetLength(groupno,max_grp-min_grp+1); + alpha := DEFAULT_ALPHA_LEVEL; + + AReport.Add(''); + AReport.Add('---------------------------------------------------------------'); + AReport.Add(' Tukey B Test for Contrasts on Ordered Means'); + AReport.Add(' alpha selected = %.2f', [alpha]); + AReport.Add('---------------------------------------------------------------'); + AReport.Add(''); + AReport.Add('Groups Difference Statistic d.f. Prob.>value Significant?'); + + divisor := sqrt(ErrorMS / groupsize); + NoGrps := max_grp - min_grp + 1; + for i := min_grp to max_grp do + groupno[i-1] := i; + for i := 1 to NoGrps - 1 do + begin + for j := i + 1 to NoGrps do + begin + if group_total[i-1] / group_count[i-1] > group_total[j-1] / group_count[j-1] then + begin + temp1 := group_total[i-1]; + temp2 := group_count[i-1]; + tempno := groupno[i-1]; + group_total[i-1] := group_total[j-1]; + group_count[i-1] := group_count[j-1]; + groupno[i-1] := groupno[j-1]; + group_total[j-1] := temp1; + group_count[j-1] := temp2; + groupno[j-1] := tempno; + end; + end; + end; + + for i := 1 to NoGrps-1 do + begin + for j := i+1 to NoGrps do + begin + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + contrast := abs((mean1 - mean2) / divisor); + df1 := j - i + 1.0; + qstat := STUDENT(contrast, ErrorDF, df1); + groups := NoGrps; + tstat := STUDENT(contrast, ErrorDF, groups); + qstat := (qstat + tstat) / 2.0; + if alpha >= qstat then + sig := 'YES' + else + sig := 'NO'; + outline := Format('%3d - %3d %10.3f %10.3f %4.0f,%4.0f %5.3f %s', [ + groupno[i-1], groupno[j-1], + mean1-mean2, contrast, df1, ErrorDF, qstat, sig + ]); + AReport.Add(outline); + end; + end; + groupno := nil; +end; + +procedure TAxSAnovaFrm.UpdateBtnStates; +var + lSelected: Boolean; + i: Integer; +begin + DepInBtn.Enabled := (VarList.ItemIndex > -1) and (GrpVar.Text = ''); + DepOutBtn.Enabled := (GrpVar.Text <> ''); + + lSelected := false; + for i := 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + RepInBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to RepList.Items.Count-1 do + if RepList.Selected[i] then + begin + lSelected := true; + break; + end; + RepOutBtn.Enabled := lSelected; +end; + +procedure TAxSAnovaFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I axsanovaunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/blkanovaunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/blkanovaunit.lfm new file mode 100644 index 000000000..fe17114b0 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/blkanovaunit.lfm @@ -0,0 +1,750 @@ +object BlksAnovaFrm: TBlksAnovaFrm + Left = 853 + Height = 454 + Top = 256 + Width = 742 + AutoSize = True + Caption = 'One, Two or Three Way Analysis of Variance' + ClientHeight = 454 + ClientWidth = 742 + Constraints.MinHeight = 450 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 49 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Fact1Grp + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Fact1Grp + Left = 441 + Height = 15 + Top = 76 + Width = 68 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 8 + Caption = 'Variable Type' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = OverallAlpha + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 386 + Width = 147 + BorderSpacing.Left = 8 + Caption = 'Alpha Level for Overall Tests' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = OverallAlpha + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = PostAlpha + AnchorSideTop.Side = asrCenter + Left = 232 + Height = 15 + Top = 386 + Width = 163 + BorderSpacing.Left = 24 + Caption = 'Alpha Level for Post-Hoc Tests:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel4 + AnchorSideBottom.Control = OverallAlpha + Left = 8 + Height = 349 + Top = 25 + Width = 201 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object Fact1Grp: TRadioGroup + AnchorSideRight.Control = GroupBox1 + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 411 + Height = 70 + Top = 99 + Width = 128 + Anchors = [akRight, akBottom] + AutoFill = True + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Factor 1' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 50 + ClientWidth = 124 + Items.Strings = ( + 'Fixed Levels' + 'Random Levels' + ) + TabOrder = 3 + end + object Fact2Grp: TRadioGroup + AnchorSideLeft.Control = Fact1Grp + AnchorSideRight.Control = Fact1Grp + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel3 + AnchorSideBottom.Side = asrBottom + Left = 411 + Height = 70 + Top = 183 + Width = 128 + Anchors = [akLeft, akRight, akBottom] + AutoFill = True + AutoSize = True + Caption = 'Factor 2' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 50 + ClientWidth = 124 + Items.Strings = ( + 'Fixed Levels' + 'Random Levels' + ) + TabOrder = 5 + end + object Fact3Grp: TRadioGroup + AnchorSideLeft.Control = Fact1Grp + AnchorSideRight.Control = Fact1Grp + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel4 + AnchorSideBottom.Side = asrBottom + Left = 411 + Height = 70 + Top = 267 + Width = 128 + Anchors = [akLeft, akRight, akBottom] + AutoFill = True + AutoSize = True + Caption = 'Factor 3' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 50 + ClientWidth = 124 + Items.Strings = ( + 'Fixed Levels' + 'Random Levels' + ) + TabOrder = 7 + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = GroupBox2 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 547 + Height = 177 + Top = 21 + Width = 187 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Post-Hoc Comparisons:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 157 + ClientWidth = 183 + TabOrder = 8 + object Scheffe: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 138 + Caption = 'Scheffe' + TabOrder = 0 + end + object TukeyHSD: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 138 + Caption = 'Tukey HSD (= n''s)' + TabOrder = 1 + end + object TukeyB: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 138 + Caption = 'Tukey B (= n''s)' + TabOrder = 2 + end + object TukeyKramer: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 138 + Caption = 'Tukey-Kramer' + TabOrder = 3 + end + object NewmanKeuls: TCheckBox + Left = 12 + Height = 19 + Top = 90 + Width = 138 + Caption = 'Newman-Keuls (= n''s)' + TabOrder = 4 + end + object Bonferoni: TCheckBox + Left = 12 + Height = 19 + Top = 111 + Width = 138 + Caption = 'Bonferroni' + TabOrder = 5 + end + object OrthoContrasts: TCheckBox + Left = 12 + Height = 19 + Top = 132 + Width = 138 + Caption = 'Orthogonal Contrasts' + TabOrder = 6 + end + end + object GroupBox2: TGroupBox + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 547 + Height = 152 + Top = 214 + Width = 187 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 132 + ClientWidth = 183 + TabOrder = 9 + object PlotMeans: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 159 + Caption = 'Plot Means Using 3D bars' + TabOrder = 0 + end + object Plot2DLines: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 159 + Caption = 'Plot Means Using 2D Lines' + TabOrder = 1 + end + object Plot3DLines: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 159 + Caption = 'Plot Means Using 3D Lines' + TabOrder = 2 + end + object Label5: TLabel + Left = 12 + Height = 15 + Top = 69 + Width = 159 + Caption = 'Corrections for unequal Var.' + ParentColor = False + end + object BrownForsythe: TCheckBox + Left = 12 + Height = 19 + Top = 86 + Width = 159 + Caption = 'Brown-Forsythe for 1-way' + TabOrder = 3 + end + object Welch: TCheckBox + Left = 12 + Height = 19 + Top = 107 + Width = 159 + Caption = 'Welch for 1-way' + TabOrder = 4 + end + end + object OverallAlpha: TEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 163 + Height = 23 + Top = 382 + Width = 45 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 10 + Text = 'OverallAlpha' + end + object PostAlpha: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = OverallAlpha + AnchorSideTop.Side = asrCenter + Left = 403 + Height = 23 + Top = 382 + Width = 51 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 11 + Text = 'PostAlpha' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 521 + Height = 25 + Top = 421 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 13 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 587 + Height = 25 + Top = 421 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 14 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 675 + Height = 25 + Top = 421 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 15 + end + object HelpBtn: TButton + Tag = 107 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 458 + Height = 25 + Top = 421 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 12 + end + object Panel1: TPanel + AnchorSideTop.Control = VarList + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + Left = 217 + Height = 60 + Top = 25 + Width = 186 + Anchors = [akTop, akRight] + AutoSize = True + BevelOuter = bvNone + ClientHeight = 60 + ClientWidth = 186 + TabOrder = 1 + object DepIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 28 + Top = 0 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInClick + Spacing = 0 + TabOrder = 0 + end + object DepOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = DepIn + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 32 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutClick + Spacing = 0 + TabOrder = 1 + end + object StaticText1: TStaticText + AnchorSideLeft.Control = DepOut + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = DepVar + Left = 36 + Height = 16 + Top = 7 + Width = 103 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + TabOrder = 2 + end + object DepVar: TEdit + AnchorSideLeft.Control = DepOut + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOut + AnchorSideBottom.Side = asrBottom + Left = 36 + Height = 23 + Top = 25 + Width = 150 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + Constraints.MinWidth = 150 + OnChange = VarChange + ReadOnly = True + TabOrder = 3 + Text = 'DepVar' + end + end + object Panel2: TPanel + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Fact1Grp + Left = 217 + Height = 60 + Top = 109 + Width = 186 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 24 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 60 + ClientWidth = 186 + TabOrder = 2 + object Fact1In: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Panel2 + Left = 0 + Height = 28 + Top = 0 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Fact1InClick + Spacing = 0 + TabOrder = 0 + end + object Fact1Out: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Fact1In + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 32 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Fact1OutClick + Spacing = 0 + TabOrder = 1 + end + object StaticText2: TStaticText + AnchorSideLeft.Control = Factor1 + AnchorSideBottom.Control = Factor1 + Left = 36 + Height = 16 + Top = 7 + Width = 87 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Bottom = 2 + Caption = 'Factor 1 Variable' + TabOrder = 2 + end + object Factor1: TEdit + AnchorSideLeft.Control = Fact1Out + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Fact1Out + AnchorSideBottom.Side = asrBottom + Left = 36 + Height = 23 + Top = 25 + Width = 150 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + Constraints.MinWidth = 150 + OnChange = VarChange + ReadOnly = True + TabOrder = 3 + Text = 'Edit1' + end + end + object Panel3: TPanel + AnchorSideTop.Control = Panel2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Fact2Grp + Left = 217 + Height = 60 + Top = 193 + Width = 186 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 24 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 60 + ClientWidth = 186 + TabOrder = 4 + object Fact2In: TBitBtn + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = Panel3 + Left = 0 + Height = 28 + Top = 0 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Fact2InClick + Spacing = 0 + TabOrder = 0 + end + object Fact2Out: TBitBtn + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = Fact2In + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 32 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Fact2OutClick + Spacing = 0 + TabOrder = 1 + end + object StaticText3: TStaticText + AnchorSideLeft.Control = Fact2In + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Factor2 + Left = 36 + Height = 16 + Top = 7 + Width = 87 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor 2 Variable' + TabOrder = 2 + end + object Factor2: TEdit + AnchorSideLeft.Control = Fact2In + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Fact2Out + AnchorSideBottom.Side = asrBottom + Left = 36 + Height = 23 + Top = 25 + Width = 150 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + Constraints.MinWidth = 150 + OnChange = VarChange + ReadOnly = True + TabOrder = 3 + Text = 'Edit1' + end + end + object Panel4: TPanel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Fact3Grp + Left = 217 + Height = 60 + Top = 277 + Width = 186 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 24 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 60 + ClientWidth = 186 + TabOrder = 6 + object Fact3In: TBitBtn + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = Panel4 + Left = 0 + Height = 28 + Top = 0 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Fact3InClick + Spacing = 0 + TabOrder = 0 + end + object Fact3Out: TBitBtn + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = Fact3In + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 32 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Fact3OutClick + Spacing = 0 + TabOrder = 1 + end + object StaticText4: TStaticText + AnchorSideLeft.Control = Fact3In + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Factor3 + Left = 36 + Height = 16 + Top = 7 + Width = 72 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor 3 Clark' + TabOrder = 2 + end + object Factor3: TEdit + AnchorSideLeft.Control = Fact3In + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel4 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Fact3Out + AnchorSideBottom.Side = asrBottom + Left = 36 + Height = 23 + Top = 25 + Width = 150 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + OnChange = VarChange + ReadOnly = True + TabOrder = 3 + Text = 'Edit1' + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 405 + Width = 742 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/blkanovaunit.pas b/applications/lazstats/source/forms/analysis/comparisons/blkanovaunit.pas new file mode 100644 index 000000000..b373a8f8f --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/blkanovaunit.pas @@ -0,0 +1,2923 @@ +// Use file "anova2.laz" for testing + +unit BlkANOVAUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, FunctionsLib, OutputUnit, DataProcs, GraphLib, + ANOVATestsUnit, ContextHelpUnit; + +type + + { TBlksAnovaFrm } + + TBlksAnovaFrm = class(TForm) + Bevel1: TBevel; + BrownForsythe: TCheckBox; + Label5: TLabel; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + Panel4: TPanel; + Welch: TCheckBox; + DepIn: TBitBtn; + DepOut: TBitBtn; + Fact1In: TBitBtn; + Fact1Out: TBitBtn; + Fact2In: TBitBtn; + Fact2Out: TBitBtn; + Fact3In: TBitBtn; + Fact3Out: TBitBtn; + HelpBtn: TButton; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + Scheffe: TCheckBox; + Plot3DLines: TCheckBox; + TukeyHSD: TCheckBox; + TukeyB: TCheckBox; + TukeyKramer: TCheckBox; + NewmanKeuls: TCheckBox; + Bonferoni: TCheckBox; + OrthoContrasts: TCheckBox; + PlotMeans: TCheckBox; + Plot2DLines: TCheckBox; + DepVar: TEdit; + Factor1: TEdit; + Factor2: TEdit; + Factor3: TEdit; + OverallAlpha: TEdit; + PostAlpha: TEdit; + GroupBox1: TGroupBox; + GroupBox2: TGroupBox; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + VarList: TListBox; + Fact1Grp: TRadioGroup; + Fact2Grp: TRadioGroup; + Fact3Grp: TRadioGroup; + StaticText1: TStaticText; + StaticText2: TStaticText; + StaticText3: TStaticText; + StaticText4: TStaticText; + procedure ComputeBtnClick(Sender: TObject); + procedure DepInClick(Sender: TObject); + procedure DepOutClick(Sender: TObject); + procedure VarChange(Sender: TObject); + procedure Fact1OutClick(Sender: TObject); + procedure Fact2InClick(Sender: TObject); + procedure Fact2OutClick(Sender: TObject); + procedure Fact3InClick(Sender: TObject); + procedure Fact3OutClick(Sender: TObject); + procedure Fact1InClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + NoSelected, intvalue, N : integer; + ColNoSelected : IntDyneVec; + outline, cellstring : string; + SSDep, SSErr, SSF1, SSF2, SSF3, SSF1F2, SSF1F3, SSF2F3, SSF1F2F3 : double; + MSDep, MSErr, MSF1, MSF2, MSF3, MSF1F2, MSF1F3, MSF2F3, MSF1F2F3 : double; + DFTot, DFErr, DFF1, DFF2, DFF3, DFF1F2, DFF1F3, DFF2F3, DFF1F2F3 : double; + Omega, OmegaF1, OmegaF2, OmegaF3, OmegaF1F2, F, MinSize, MaxSize : double; + OmegaF1F3, OmegaF2F3, OmegaF1F2F3 : double; + FF1, FF2, FF1F2, ProbF1, ProbF2, ProbF3, ProbF1F2, ProbF1F3 : double; + FF3, FF2F3, FF1F3, FF1F2F3, ProbF2F3, ProbF1F2F3 : double; + DepVarCol, F1Col, F2Col, F3Col, Nf1cells, Nf2cells, Nf3cells : integer; + MeanDep, MeanF1, MeanF2, MeanF3, X : double; + minf1, maxf1, minf2, maxf2, minf3, maxf3, nofactors, totcells : integer; + cellcnts : DblDyneVec; // array of cell counts + cellvars : DblDyneVec; // arrray of cell sums of squares then variances + cellsums : DblDyneVec; // array of cell sums then means + equal_grp : boolean; // check for equal groups for post-hoc tests + counts : DblDyneMat; // matrix for 2-way containing cell sizes + sums : DblDyneMat; // matrix for 2-way containing cell sums + vars : DblDyneMat; // matrix for 2-way containing sums of squares + RowSums : DblDyneVec; // 2 way row sums + ColSums : DblDyneVec; // 2 way col sums + RowCount : DblDyneVec; // 2 way row count + ColCount : DblDyneVec; // 2 way col count + SlcSums : DblDyneVec; // 3 way slice sums + SlcCount : DblDyneVec; // 3 way slice counts + NoGrpsA, NoGrpsB, NoGrpsC : integer; + OrdMeansA, OrdMeansB, OrdMeansC : DblDyneVec; // reordered means for f1, f2, f3 + allAlpha, PostHocAlpha : double; // alphas for tests +// wsum : array[1..20,1..20,1..20] of double; // sums for 3 way +// ncnt : array[1..20,1..20,1..20] of integer; // n in 3 way cells +// wx2 : array[1..20,1..20,1..20] of double; // sums of squares for 3 way cells + wsum, wx2 : DblDyneCube; + ncnt : IntDyneCube; + OKterms : array[1..14] of integer; + CompError : boolean; + + procedure GetLevels; + procedure Calc1Way; + procedure OneWayTable(AReport: TStrings); + procedure OneWayPlot; + procedure Calc2Way; + procedure TwoWayTable(AReport: TStrings); + procedure TwoWayPlot; + procedure TwoWayContrasts(AReport: TStrings); + procedure Calc3Way; + procedure ThreeWayTable(AReport: TStrings); + procedure ThreeWayPlot; + procedure ThreeWayContrasts(AReport: TStrings); + procedure BrownForsytheOneWay(AReport: TStrings); + procedure WelchOneWay(AReport: TStrings); + procedure WelchtTests(AReport: TStrings); + + procedure UpdateBtnStates; + function Validate(out AMsg: String; out AControl: TWinControl; + DepVarIndex, Fact1Index, Fact2Index, Fact3Index: Integer): Boolean; + + public + { public declarations } + end; + +var + BlksAnovaFrm: TBlksAnovaFrm; + +implementation + +uses + Math; + +{ TBlksAnovaFrm } + +procedure TBlksAnovaFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + DepVar.Text := ''; + Factor1.Text := ''; + Factor2.Text := ''; + Factor3.Text := ''; + Fact1Grp.ItemIndex := 0; + Fact2Grp.ItemIndex := 0; + Fact3Grp.ItemIndex := 0; + PlotMeans.Checked := false; + Scheffe.Checked := false; + TukeyHSD.Checked := false; + TukeyB.Checked := false; + TukeyKramer.Checked := false; + NewmanKeuls.Checked := false; + Bonferoni.Checked := false; + PostAlpha.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL); + OverAllalpha.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL); + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TBlksAnovaFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinWidth := OverallAlpha.Left + OverallAlpha.Width - VarList.Left; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TBlksAnovaFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); + + OverallAlpha.Text := FloatToStr(DEFAULT_ALPHA_LEVEL); + PostAlpha.Text := FloatToStr(DEFAULT_ALPHA_LEVEL); +end; + +procedure TBlksAnovaFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TBlksAnovaFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TBlksAnovaFrm.DepInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepVar.Text = '') then + begin + DepVar.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TBlksAnovaFrm.ComputeBtnClick(Sender: TObject); +var + i: integer; + msg: String; + C: TWinControl; + lReport: TStrings; + + procedure CleanIt; + begin + cellcnts := nil; + cellvars := nil; + cellsums := nil; + ColNoSelected := nil; + end; + +begin + lReport := TStringList.Create; + try + // initialize values + SetLength(ColNoSelected,NoVariables); + DepVarCol := 0; + F1Col := 0; + F2Col := 0; + F3Col := 0; + SSDep := 0.0; + SSF1 := 0.0; + SSF2 := 0.0; + SSF3 := 0.0; + SSF1F2 := 0.0; + SSF1F3 := 0.0; + SSF2F3 := 0.0; + SSF1F2F3 := 0.0; + MeanDep := 0.0; + MeanF1 := 0.0; + MeanF2 := 0.0; + MeanF3 := 0.0; + Nf1cells := 0; + Nf2cells := 0; + Nf3cells := 0; + N := 0; + NoSelected := 0; + minf1 := 0; + maxf1 := 0; + minf2 := 0; + maxf2 := 0; + minf3 := 0; + maxf3 := 0; + + // Get column numbers of dependent variable and factors + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = DepVar.Text then + begin + DepVarCol := i; + NoSelected := NoSelected + 1; + ColNoSelected[NoSelected-1] := DepVarCol; + end; + if cellstring = Factor1.Text then + begin + F1Col := i; + NoSelected := NoSelected + 1; + ColNoSelected[NoSelected-1] := F1Col; + end; + if cellstring = Factor2.Text then + begin + F2Col := i; + NoSelected := NoSelected + 1; + ColNoSelected[NoSelected-1] := F2Col; + end; + if cellstring = Factor3.Text then + begin + F3Col := i; + NoSelected := NoSelected + 1; + ColNoSelected[NoSelected-1] := F3Col; + end; + end; + + if not Validate(msg, C, DepVarCol, F1Col, F2Col, F3Col) then begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + exit; + end; + + if F2Col = 0 then nofactors := 1 else nofactors := 2; + if F3Col <> 0 then nofactors := 3; + allAlpha := StrToFloat(OverAllalpha.Text); + PostHocAlpha := StrToFloat(PostAlpha.Text); + + // get min and max of each factor code + GetLevels; + + // allocate space + SetLength(cellcnts, totcells); // array of cell counts + SetLength(cellvars, totcells); // arrray of cell sums of squares then variances + SetLength(cellsums, totcells); // array of cell sums then means + + // initialize array values + for i := 1 to totcells do + begin + cellsums[i-1] := 0.0; + cellvars[i-1] := 0.0; + cellcnts[i-1] := 0; + end; + + // do analysis + case nofactors of + 1 : // single factor anova + begin + Calc1Way; + if CompError then + exit; + OneWayTable(lReport); // output the results + if Scheffe.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf1, maxf1,N, posthocAlpha, lReport); + if TukeyHSD.Checked and equal_grp then + Tukey(MSErr, DFErr, MinSize, cellsums, cellcnts, minf1, maxf1, posthocAlpha, lReport); + if TukeyB.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf1, maxf1, MinSize, posthocAlpha, lReport); + if TukeyKramer.Checked then + Tukey_Kramer(MSErr, DFErr, MinSize, cellsums, cellcnts, minf1, maxf1, posthocAlpha, lReport); + if NewmanKeuls.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, MinSize, cellsums, cellcnts, minf1, maxf1, posthocAlpha, lReport); + if Bonferoni.Checked then + Bonferroni(cellsums, cellcnts, cellvars, minf1, maxf1, posthocAlpha, lReport); + if OrthoContrasts.Checked then + Contrasts(MSErr, DFErr, cellsums, cellcnts, minf1, maxf1, 0.05, lReport); + //OutputFrm.ShowModal; + if (PlotMeans.Checked) or (Plot2DLines.Checked) or (Plot3DLines.Checked) then + OneWayPlot; + if BrownForsythe.Checked then BrownForsytheOneWay(lReport); + if Welch.Checked then WelchOneWay(lReport); + end; + + 2 : // two-way anova + begin + SetLength(counts,Nf1cells,Nf2cells); // matrix for 2-way containing cell sizes + SetLength(sums,Nf1cells,Nf2cells); // matrix for 2-way containing cell sums + SetLength(vars,Nf1cells,Nf2cells); // matrix for 2-way containing sums of squares + SetLength(RowSums,Nf1cells); // 2 way row sums + SetLength(ColSums,Nf2cells); // 2 way col sums + SetLength(RowCount,Nf1cells); // 2 way row count + SetLength(ColCount,Nf2cells); // 2 way col count + SetLength(OrdMeansA,Nf1cells); // ordered means for factor 1 + SetLength(OrdMeansB,Nf2cells); // ordered means for factor 2 + + Calc2Way; + if not CompError then + begin + TwoWayTable(lReport); + TwoWayContrasts(lReport); + //OutputFrm.ShowModal; + if PlotMeans.Checked or Plot2DLines.Checked or Plot3DLines.Checked then + TwoWayPlot; + end; + OrdMeansB := nil; + OrdMeansA := nil; + ColCount := nil; + RowCount := nil; + ColSums := nil; + RowSums := nil; + vars := nil; + sums := nil; + counts := nil; + end; + + 3 : // three way anova + begin + SetLength(RowSums,Nf1cells); // 2 way row sums + SetLength(ColSums,Nf2cells); // 2 way col sums + SetLength(RowCount,Nf1cells); // 2 way row count + SetLength(ColCount,Nf2cells); // 2 way col count + SetLength(SlcSums,Nf3cells); // 3 way slice sums + SetLength(SlcCount,Nf3cells); // 3 way slice counts + SetLength(OrdMeansA,Nf1cells); // ordered means for factor 1 + SetLength(OrdMeansB,Nf2cells); // ordered means for factor 2 + SetLength(OrdMeansC,Nf3cells); // ordered means for factor 3 + SetLength(wsum,Nf1cells,Nf2cells,Nf3cells); + SetLength(wx2,Nf1cells,Nf2cells,Nf3cells); + SetLength(ncnt,Nf1cells,Nf2cells,Nf3cells); + + Calc3Way; + if not CompError then + begin + ThreeWayTable(lReport); + ThreeWayContrasts(lReport); + //OutputFrm.ShowModal; + if (PlotMeans.Checked) or (Plot2DLines.Checked) or (Plot3DLines.Checked) then + ThreeWayPlot; + end; + ncnt := nil; + wx2 := nil; + wsum := nil; + OrdMeansC := nil; + OrdMeansB := nil; + OrdMeansA := nil; + SlcCount := nil; + SlcSums := nil; + ColCount := nil; + ColSums := nil; + RowCount := nil; + RowSums := nil; + end; + end; + + DisplayReport(lReport); + + finally + lReport.Free; + CleanIt; + end; +end; + +procedure TBlksAnovaFrm.DepOutClick(Sender: TObject); +begin + if DepVar.Text <> '' then + begin + VarList.Items.Add(DepVar.Text); + DepVar.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TBlksAnovaFrm.VarChange(Sender: TObject); +begin + UpdateBtnStates; +end; + +procedure TBlksAnovaFrm.Fact1OutClick(Sender: TObject); +begin + if Factor1.Text <> '' then + begin + VarList.Items.Add(Factor1.Text); + Factor1.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TBlksAnovaFrm.Fact2InClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (Factor2.Text = '') then + begin + Factor2.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TBlksAnovaFrm.Fact2OutClick(Sender: TObject); +begin + if Factor2.Text <> '' then + begin + VarList.Items.Add(Factor2.Text); + Factor2.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TBlksAnovaFrm.Fact3InClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (Factor3.Text = '') then + begin + Factor3.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TBlksAnovaFrm.Fact3OutClick(Sender: TObject); +begin + if Factor3.Text <> '' then + begin + VarList.Items.Add(Factor3.Text); + Factor3.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TBlksAnovaFrm.Fact1InClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (Factor1.Text = '') then + begin + Factor1.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TBlksAnovaFrm.GetLevels; +var + i: integer; +begin + minf1 := MaxInt; + maxf1 := -MaxInt; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]))); + if intvalue > maxf1 then maxf1 := intvalue; + if intvalue < minf1 then minf1 := intvalue; + end; + Nf1cells := maxf1 - minf1 + 1; + + if nofactors > 1 then + begin + minf2 := MaxInt; + maxf2 := -MaxInt; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F2Col,i]))); + if intvalue > maxf2 then maxf2 := intvalue; + if intvalue < minf2 then minf2 := intvalue; + end; + Nf2cells := maxf2 - minf2 + 1; + end; + + if nofactors = 3 then + begin + minf3 := MaxInt; + maxf3 := -MaxInt; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F3Col,i]))); + if intvalue > maxf3 then maxf3 := intvalue; + if intvalue < minf3 then minf3 := intvalue; + end; + Nf3cells := maxf3 - minf3 + 1; + + Caption := IntToStr(Nf3Cells); + end; + + totcells := Nf1cells + Nf2cells + Nf3cells; +end; + +procedure TBlksAnovaFrm.Calc1Way; +var + i: integer; +begin + CompError := false; + + // get working totals + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]))); + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepVarCol,i])); + intvalue := intvalue - minf1 + 1; + cellcnts[intvalue-1] := cellcnts[intvalue-1] + 1; + cellsums[intvalue-1] := cellsums[intvalue-1] + X; + cellvars[intvalue-1] := cellvars[intvalue-1] + (X * X); + MeanDep := MeanDep + X; + SSDep := SSDep + (X * X); + N := N + 1; + end; + + DFF1 := 0; + for i := 0 to Nf1cells-1 do + begin + if cellcnts[i] > 0 then + begin + SSF1 := SSF1 + (sqr(cellsums[i]) / cellcnts[i]); + DFF1 := DFF1 + 1; + end; + end; + + SSF1 := SSF1 - (sqr(MeanDep) / N); + SSDep := SSDep - (sqr(MeanDep) / N); + SSErr := SSDep - SSF1; + DFTot := N - 1; + DFF1 := DFF1 - 1; + DFErr := DFTot - DFF1; + MSF1 := SSF1 / DFF1; + MSErr := SSErr / DFErr; + MSDep := SSDep / DFTot; + Omega := (SSF1 - DFF1 * MSErr) / (SSDep + MSErr); + F := MSF1 / MSErr; + ProbF1 := probf(F,DFF1, DFErr); + MeanDep := MeanDep / N; +end; + +procedure TBlksAnovaFrm.OneWayTable(AReport: TStrings); +var + i, grpsize: integer; + minvar, maxvar, sumvar, sumfreqlogvar, sumDFrecip: double; + c, bartlett, cochran, hartley, chiprob: double; +begin + AReport.Add('ONE WAY ANALYSIS OF VARIANCE RESULTS'); + AReport.Add(''); + AReport.Add('Dependent variable is: %s, Independent variable is: %s', [DepVar.Text, Factor1.Text]); + AReport.Add(''); + AReport.Add('---------------------------------------------------------------------'); + AReport.Add('SOURCE D.F. SS MS F PROB.>F OMEGA SQR.'); + AReport.Add('---------------------------------------------------------------------'); + AReport.Add('BETWEEN %4.0f%10.2f%10.2f%10.2f%10.2f%10.2f', [DFF1, SSF1, MSF1, F, ProbF1, Omega]); + AReport.Add('WITHIN %4.0f%10.2f%10.2f', [DFErr, SSErr, MSErr]); + AReport.Add('TOTAL %4.0f%10.2f', [DFTot, SSDep]); + AReport.Add('---------------------------------------------------------------------'); + AReport.Add(''); + AReport.Add('MEANS AND VARIABILITY OF THE DEPENDENT VARIABLE FOR LEVELS OF THE INDEPENDENT VARIABLE'); + AReport.Add('---------------------------------------------------------------------'); + AReport.Add('GROUP MEAN VARIANCE STD.DEV. N'); + Areport.Add('---------------------------------------------------------------------'); + + equal_grp := true; + minvar := 1e20; + maxvar := 0.0; + sumvar := 0.0; + sumDFrecip := 0.0; + sumfreqlogvar := 0.0; + grpsize := round(cellcnts[0]); + MinSize := grpsize; // initialized minimum group size + MaxSize := grpsize; // initialize maximum group size + for i := 0 to NF1cells-1 do + begin + grpsize := round(cellcnts[i]); + if grpsize < MinSize then + begin + MinSize := grpsize; + equal_grp := false; + end; + if grpsize > MaxSize then + MaxSize := grpsize; + + if cellcnts[i] > 1 then + begin + cellvars[i] := cellvars[i] - (sqr(cellsums[i]) / cellcnts[i]); + cellvars[i] := cellvars[i] / (cellcnts[i] - 1); + if cellvars[i] > maxvar then maxvar := cellvars[i]; + if cellvars[i] < minvar then minvar := cellvars[i]; + sumvar :=sumvar + cellvars[i]; + sumDFrecip := sumDFrecip + (1.0 / (cellcnts[i] - 1.0)); + sumfreqlogvar := sumfreqlogvar + (cellcnts[i] - 1) * Log10(cellvars[i]); + end; + + if cellcnts[i] > 0 then + AReport.Add('%4d %10.2f%10.2f%10.2f%4.0f', [ + i+1, cellsums[i] / cellcnts[i], cellvars[i], sqrt(cellvars[i]), cellcnts[i] + ]); + end; + + AReport.Add('---------------------------------------------------------------------'); + AReport.Add('TOTAL%10.2f%10.2f%10.2f%4d', [MeanDep, MSDep, sqrt(MSDep), N]); + AReport.Add('---------------------------------------------------------------------'); + AReport.Add(''); + + c := 1.0 + (1.0 / (3 * DFF1)) * (sumDFrecip - (1.0 / DFErr)); + bartlett := (2.303 / c) * ((DFErr * Log10(MSErr)) - sumfreqlogvar); + chiprob := 1.0 - chisquaredprob(bartlett,round(DFF1)); + cochran := maxvar / sumvar; + hartley := maxvar / minvar; + + AReport.Add('TESTS FOR HOMOGENEITY OF VARIANCE'); + AReport.Add('---------------------------------------------------------------------'); + AReport.Add('Hartley Fmax test statistic = %.2f with deg.s freedom: %d and %.0f.', [hartley, NF1cells, MaxSize - 1]); + AReport.Add('Cochran C statistic = %.2f with deg.s freedom: %d and %.0f.', [cochran, NF1cells, MaxSize - 1]); + AReport.Add('Bartlett Chi-square = %0.2f with %.0f D.F. Prob. > Chi-Square = %.3f', [bartlett, DFF1, chiprob]); + AReport.Add('---------------------------------------------------------------------'); +end; + +procedure TBlksAnovaFrm.OneWayPlot; +var + i : integer; + maxmean : double; + XValue : DblDyneVec; + setstring : string[11]; + plottype : integer; + +begin + plottype := 2; + SetLength(XValue,Nf1cells); + if PlotMeans.Checked then plottype := 2; + if Plot2DLines.Checked then plottype := 5; + if Plot3DLines.Checked then plottype := 6; + maxmean := 0.0; + setstring := 'FACTOR A'; + GraphFrm.SetLabels[1] := setstring; + SetLength(GraphFrm.YPoints,1,NF1cells); + SetLength(GraphFrm.Xpoints,1,NF1cells); + for i := 1 to NF1cells do + begin + cellsums[i-1] := cellsums[i-1] / cellcnts[i-1]; + GraphFrm.Ypoints[0,i-1] := cellsums[i-1]; + if cellsums[i-1] > maxmean then maxmean := cellsums[i-1]; + XValue[i-1] := minF1 + i - 1; + GraphFrm.Xpoints[0,i-1] := XValue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NF1cells; + GraphFrm.Heading := Factor1.Text; + GraphFrm.XTitle := 'FACTOR A LEVEL'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; // 3d Vertical Bar Chart + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + XValue := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +procedure TBlksAnovaFrm.Calc2Way; +var + i, j : integer; + grpA, grpB : integer; + Constant, RowsTotCnt, ColsTotCnt, SSCells : double; + +begin + CompError := false; + + // initialize matrix values + NoGrpsA := maxf1 - minf1 + 1; + NoGrpsB := maxf2 - minf2 + 1; + for i := 1 to NoGrpsA do + begin + RowSums[i-1] := 0.0; + RowCount[i-1] := 0.0; + for j := 1 to NoGrpsB do + begin + counts[i-1,j-1] := 0.0; + sums[i-1,j-1] := 0.0; + vars[i-1,j-1] := 0.0; + end; + end; + for i := 1 to NoGrpsB do + begin + ColCount[i-1] := 0.0; + ColSums[i-1] := 0.0; + end; + N := 0; + MeanDep := 0.0; + SSDep := 0.0; + SSCells := 0.0; + RowsTotCnt := 0.0; + ColsTotCnt := 0.0; + // get working totals + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + grpA := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]))); + grpB := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F2Col,i]))); + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepVarCol,i])); + grpA := grpA - minf1 + 1; + grpB := grpB - minf2 + 1; + counts[grpA-1,grpB-1] := counts[grpA-1,grpB-1] + 1; + sums[grpA-1,grpB-1] := sums[grpA-1,grpB-1] + X; + vars[grpA-1,grpB-1] := vars[grpA-1,grpB-1] + (X * X); + RowSums[GrpA-1] := RowSums[GrpA-1] + X; + ColSums[GrpB-1] := ColSums[GrpB-1] + X; + RowCount[GrpA-1] := RowCount[GrpA-1] + 1.0; + ColCount[GrpB-1] := ColCount[GrpB-1] + 1.0; + MeanDep := MeanDep + X; + SSDep := SSDep + (X * X); + N := N + 1; + end; + + // Calculate results + for i := 0 to NoGrpsA-1 do + begin + SSF1 := SSF1 + ((RowSums[i] * RowSums[i]) / RowCount[i]); + RowsTotCnt := RowsTotCnt + RowCount[i]; + end; + for j := 0 to NoGrpsB-1 do + begin + SSF2 := SSF2 + ((ColSums[j] * ColSums[j]) / ColCount[j]); + ColsTotCnt := ColsTotCnt + ColCount[j]; + end; + for i := 0 to NoGrpsA-1 do + begin + for j := 0 to NoGrpsB-1 do + if counts[i,j] > 0 then + SSCells := SSCells + ((sums[i,j] * sums[i,j]) / counts[i,j]); + end; + if N > 0 then Constant := (MeanDep * MeanDep) / N else Constant := 0.0; + SSF1 := SSF1 - Constant; + SSF2 := SSF2 - Constant; + SSF1F2 := SSCells - SSF1 - SSF2 - Constant; + SSErr := SSDep - SSCells; + SSDep := SSDep - Constant; + + if (SSF1F2 < 0) or (SSF1 < 0) or (SSF2 < 0) then + begin + MessageDlg('A negative SS found. Unbalanced design? Ending analysis.', mtError, [mbOK], 0); + CompError := true; + exit; + end; + + DFTot := N - 1; + DFF1 := NoGrpsA - 1; + DFF2 := NoGrpsB - 1; + DFF1F2 := DFF1 * DFF2; + DFErr := DFTot - DFF1 - DFF2 - DFF1F2; +// DFCells := N - (NoGrpsA * NoGrpsB); + MSF1 := SSF1 / DFF1; + MSF2 := SSF2 / DFF2; + MSF1F2 := SSF1F2 / DFF1F2; + MSErr := SSErr / DFErr; + MSDep := SSDep / DFTot; + OmegaF1 := (SSF1 - DFF1 * MSErr) / (SSDep + MSErr); + OmegaF2 := (SSF2 - DFF2 * MSErr) / (SSDep + MSErr); + OmegaF1F2 := (SSF1F2 - DFF1F2 * MSErr) / (SSDep + MSErr); + Omega := OmegaF1 + OmegaF2 + OmegaF1F2; + MeanDep := MeanDep / N; + // f tests for fixed effects + if (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 0) then + begin + FF1 := abs(MSF1 / MSErr); + FF2 := abs(MSF2 / MSErr); + FF1F2 := abs(MSF1F2 / MSErr); + ProbF1 := probf(FF1,DFF1,DFErr); + ProbF2 := probf(FF2,DFF2,DFErr); + ProbF1F2 := probf(FF1F2,DFF1F2,DFErr); + end; + // f tests if both factors are random + if (Fact1Grp.ItemIndex = 1) and (Fact2Grp.ItemIndex = 1) then + begin + FF1 := abs(MSF1 / MSF1F2); + FF2 := abs(MSF2 / MSF1F2); + FF1F2 := abs(MSF1F2 / MSErr); + ProbF1 := probf(FF1,DFF1,DFF1F2); + ProbF2 := probf(FF2,DFF2,DFF1F2); + ProbF3 := probf(FF1F2,DFF1F2,DFErr); + end; + // f test if factor A is random + if (Fact1Grp.ItemIndex = 1) and (Fact2Grp.ItemIndex = 0) then + begin + FF1 := abs(MSF1 / MSErr); + FF2 := abs(MSF2 / MSF1F2); + FF1F2 := abs(MSF1F2 / MSErr); + ProbF1 := probf(FF1,DFF1,DFErr); + ProbF2 := probf(FF2,DFF2,DFF1F2); + ProbF3 := probf(FF1F2,DFF1F2,DFErr); + end; + // f test if factor b is random + if (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 1) then + begin + FF1 := abs(MSF1 / MSF1F2); + FF2 := abs(MSF2 / MSErr); + FF1F2 := abs(MSF1F2 / MSErr); + ProbF1 := probf(FF1,DFF1,DFF1F2); + ProbF2 := probf(FF2,DFF2,DFErr); + ProbF3 := probf(FF1F2,DFF1F2,DFErr); + end; + if (ProbF1 > 1.0) then ProbF1 := 1.0; + if (ProbF2 > 1.0) then ProbF2 := 1.0; + if (ProbF1F2 > 1.0) then ProbF1F2 := 1.0; + + // Obtain omega squared (proportion of dependent variable explained) + if (OmegaF1 < 0.0) then OmegaF1 := 0.0; + if (OmegaF2 < 0.0) then OmegaF2 := 0.0; + if (OmegaF1F2 < 0.0) then OmegaF1F2 := 0.0; + //Omega = ( (SSF1 + SSF2 + SSF1F2) - (DFF1 + DFF2 + DFF1F2) * MSErr) / (SSDep + MSErr); + if (Omega < 0.0) then Omega := 0.0; +end; + +procedure TBlksAnovaFrm.TwoWayTable(AReport: TStrings); +var + groupsize: integer; + MinVar, MaxVar, sumvars, sumDFrecip: double; + i, j: integer; + XBar, V, S, RowSS, ColSS: double; + sumfreqlogvar, c, bartlett, cochran, hartley, chiprob: double; +begin + if CompError then + exit; + + AReport.Add('Two Way Analysis of Variance'); + AReport.Add(''); + AReport.Add('Variable analyzed: %s', [DepVar.Text]); + AReport.Add(''); + + outline := format('Factor A (rows) variable: %s',[Factor1.Text]); + if Fact1Grp.ItemIndex = 0 then + outline := outline + ' (Fixed Levels)' + else + outline := outline + ' (Random Levels)'; + AReport.Add(outline); + + outline := format('Factor B (columns) variable: %s',[Factor2.Text]); + if Fact2Grp.ItemIndex = 0 then + outline := outline + ' (Fixed Levels)' + else + outline := outline + ' (Random Levels)'; + AReport.Add(outline); + AReport.Add(''); + + AReport.Add('SOURCE D.F. SS MS F PROB.> F Omega Squared'); + AReport.Add(''); + AReport.Add('Among Rows %4.0f %8.3f %8.3f %8.3f %6.3f %6.3f', [DFF1, SSF1, MSF1, FF1, ProbF1, OmegaF1]); + AReport.Add('Among Columns %4.0f %8.3f %8.3f %8.3f %6.3f %6.3f', [DFF2, SSF2, MSF2, FF2, ProbF2, OmegaF2]); + AReport.Add('Interaction %4.0f %8.3f %8.3f %8.3f %6.3f %6.3f', [DFF1F2, SSF1F2, MSF1F2, FF1F2, ProbF1F2, OmegaF1F2]); + AReport.Add('Within Groups %4.0f %8.3f %8.3f', [DFErr, SSErr, MSErr]); + AReport.Add('Total %4.0f %8.3f %8.3f', [DFTot, SSDep, MSDep]); + AReport.Add(''); + AReport.Add('Omega squared for combined effects = %8.3f', [Omega]); + AReport.Add(''); + if (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 0) then + AReport.Add('Note: Denominator of F ratio is MSErr'); + if (Fact1Grp.ItemIndex = 1) and (Fact2Grp.ItemIndex = 1) then + AReport.Add('Note: Denominator of F ratio is MSAxB'); + if (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 1) then + begin + AReport.Add('Note: Denominator of F ratio for A is MSAxB'); + AReport.Add('and denominator for B and AxB is MSErr'); + end; + if (Fact1Grp.ItemIndex = 1) and (Fact2Grp.ItemIndex = 0) then + begin + AReport.Add('Note: Denominator of F ratio for B is MSAxB'); + AReport.Add('and denominator for A and AxB is MSErr'); + end; + AReport.Add(''); + AReport.Add('Descriptive Statistics'); + AReport.Add(''); + AReport.Add('GROUP Row Col. N MEAN VARIANCE STD.DEV.'); + groupsize := round(counts[0,0]); + equal_grp := true; + MaxVar := 0.0; + MinVar := 1e20; + sumvars := 0.0; + sumfreqlogvar := 0.0; + sumDFrecip := 0.0; + + // Display cell means, variances, standard deviations + V := 0.0; + XBar := 0.0; + S := 0.0; + for i := 0 to NoGrpsA-1 do + begin + for j := 0 to NoGrpsB-1 do + begin + if counts[i,j] > 1 then + begin + XBar := sums[i,j] / counts[i,j]; + V := vars[i,j] - ( (sums[i,j] * sums[i,j]) / counts[i,j]); + V := V / (counts[i,j] - 1.0); + S := sqrt(V); + sumvars := sumvars + V; + if V > MaxVar then MaxVar := V; + if V < MinVar then MinVar := V; + sumDFrecip := sumDFrecip + (1.0 / (counts[i,j] - 1.0)); + sumfreqlogvar := sumfreqlogvar + ((counts[i,j] - 1.0) * ln(V)); + if counts[i,j] <> groupsize then equal_grp := false; + end; + AReport.Add('Cell %3d %3d %3.0f %8.3f %8.3f %8.3f', [minf1+i, minf2+j, counts[i,j], XBar, V, S]); + end; + end; + + //Display Row means, variances, standard deviations + for i := 0 to NoGrpsA-1 do + begin + XBar := RowSums[i] / RowCount[i]; + OrdMeansA[i] := XBar; + RowSS := 0.0; + for j := 0 to NoGrpsB-1 do RowSS := RowSS + vars[i,j]; + V := RowSS - (RowSums[i] * RowSums[i] / RowCount[i]); + V := V / (RowCount[i] - 1.0); + S := sqrt(V); + AReport.Add('Row %3d %3.0f %8.3f %8.3f %8.3f', [minf1+i, RowCount[i], XBar, V, S]); + end; + + //Display means, variances and standard deviations for columns + for j := 0 to NoGrpsB-1 do + begin + XBar := ColSums[j] / ColCount[j]; + OrdMeansB[j] := XBar; + ColSS := 0.0; + for i := 0 to NoGrpsA-1 do ColSS := ColSS + vars[i,j]; + if ColCount[j] > 0 then V := ColSS - (ColSums[j] * ColSums[j] / ColCount[j]); + if ColCount[j] > 1 then V := V / (ColCount[j] - 1.0); + if V > 0.0 then S := sqrt(V); + AReport.Add('Col %3d %3.0f %8.3f %8.3f %8.3f', [minf2+j, ColCount[j], XBar, V, S]); + end; + + AReport.Add('TOTAL %3d %8.3f %8.3f %8.3f', [N, MeanDep, MSDep, sqrt(MSDep)]); + AReport.Add(''); + AReport.Add(''); + + c := 1.0 + (1.0 / (3.0 * NoGrpsA * NoGrpsB - 1.0)) * (sumDFrecip - (1.0 / DFErr)); + bartlett := (2.303 / c) * ((DFErr * ln(MSErr)) - sumfreqlogvar); + chiprob := 1.0 - chisquaredprob(bartlett,round(NoGrpsA * NoGrpsB - 1)); + cochran := maxvar / sumvars; + hartley := maxvar / minvar; + + AReport.Add('TESTS FOR HOMOGENEITY OF VARIANCE'); + AReport.Add('---------------------------------------------------------------------'); + AReport.Add('Hartley Fmax test statistic = %10.2f with deg.s freedom: %d and %d.', [hartley, NoGrpsA*NoGrpsB, groupsize-1]); + AReport.Add('Cochran C statistic = %10.2f with deg.s freedom: %d and %d.', [cochran, NoGrpsA*NoGrpsB, groupsize - 1]); + AReport.Add('Bartlett Chi-square statistic = %10.2f with %4d D.F. Prob. larger value = %6.3f', [bartlett, NoGrpsA*NoGrpsB - 1, chiprob]); + AReport.Add('---------------------------------------------------------------------'); +end; + +procedure TBlksAnovaFrm.TwoWayPlot; +var + i, j : integer; + maxmean, XBar : double; + XValue : DblDyneVec; + title : string; + plottype : integer; + setstring : string[11]; + +begin + if CompError then + exit; + + SetLength(XValue,Nf1cells+Nf2cells); + plottype := 2; + if PlotMeans.Checked then plottype := 2; + if Plot2DLines.Checked then plottype := 5; + if Plot3DLines.Checked then plottype := 6; + + // do Factor A first + setstring := 'FACTOR A'; + GraphFrm.SetLabels[1] := setstring; + maxmean := 0.0; + SetLength(GraphFrm.Xpoints,1,NF1cells); + SetLength(GraphFrm.Ypoints,1,NF1cells); + for i := 1 to NF1cells do + begin + RowSums[i-1] := RowSums[i-1] / RowCount[i-1]; + GraphFrm.Ypoints[0,i-1] := RowSums[i-1]; + if RowSums[i-1] > maxmean then maxmean := RowSums[i-1]; + XValue[i-1] := minF1 + i - 1; + GraphFrm.Xpoints[0,i-1] := XValue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NF1cells; + GraphFrm.Heading := Factor1.Text; + title := Factor1.Text + ' Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + // do Factor B next + setstring := 'FACTOR B'; + GraphFrm.SetLabels[1] := setstring; + maxmean := 0.0; + SetLength(GraphFrm.Xpoints,1,NF2cells); + SetLength(GraphFrm.Ypoints,1,NF2cells); + for i := 1 to NF2cells do + begin + ColSums[i-1] := ColSums[i-1] / ColCount[i-1]; + GraphFrm.Ypoints[0,i-1] := ColSums[i-1]; + if ColSums[i-1] > maxmean then maxmean := ColSums[i-1]; + XValue[i-1] := minF1 + i - 1; + GraphFrm.Xpoints[0,i-1] := XValue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NF2cells; + GraphFrm.Heading := Factor2.Text; + title := Factor2.Text + ' Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + + // do Factor A x B Interaction next + maxmean := 0.0; + SetLength(GraphFrm.Ypoints,NF1cells,NF2cells); + SetLength(GraphFrm.Xpoints,1,NF2cells); + for i := 1 to NF1cells do + begin + setstring := Factor1.Text + ' ' + IntToStr(i); + GraphFrm.SetLabels[i] := setstring; + for j := 1 to NF2cells do + begin + XBar := sums[i-1,j-1] / counts[i-1,j-1]; + if XBar > maxmean then maxmean := XBar; + GraphFrm.Ypoints[i-1,j-1] := XBar; + end; + end; + for j := 1 to NF2cells do + begin + XValue[j-1] := minF2 + j - 1; + GraphFrm.Xpoints[0,j-1] := XValue[j-1]; + end; + + GraphFrm.nosets := NF1cells; + GraphFrm.nbars := NF2cells; + GraphFrm.Heading := 'Factor A x Factor B'; + title := Factor2.Text + ' Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + XValue := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +procedure TBlksAnovaFrm.Calc3Way; +var + i, j, k : integer; + grpA, grpB, grpC : integer; + Constant, RowsTotCnt, ColsTotCnt, SlcsTotCnt, SSCells : double; + p, n2 : double; + +begin + CompError := false; + + // initialize matrix values + NoGrpsA := maxf1 - minf1 + 1; + NoGrpsB := maxf2 - minf2 + 1; + NoGrpsC := maxf3 - minf3 + 1; + for i := 0 to NoGrpsA-1 do + begin + RowSums[i] := 0.0; + RowCount[i] := 0.0; + for j := 0 to NoGrpsB-1 do + begin + for k := 0 to NoGrpsC-1 do + begin + wsum[i,j,k] := 0.0; + ncnt[i,j,k] := 0; + wx2[i,j,k] := 0.0; + end; + end; + end; + for i := 0 to NoGrpsB-1 do + begin + ColCount[i] := 0.0; + ColSums[i] := 0.0; + end; + for i := 0 to NoGrpsC-1 do + begin + SlcCount[i] := 0.0; + SlcSums[i] := 0.0; + end; + N := 0; + MeanDep := 0.0; + SSDep := 0.0; + RowsTotCnt := 0.0; + ColsTotCnt := 0.0; + SlcsTotCnt := 0.0; + SSF1 := 0.0; + SSF2 := 0.0; + SSF3 := 0.0; + SSF1F2 := 0.0; + SSF1F3 := 0.0; + SSF2F3 := 0.0; + SSF1F2F3 := 0.0; + SSCells := 0.0; + + // get working totals + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + grpA := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]))); + grpB := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F2Col,i]))); + grpC := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F3Col,i]))); + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepVarCol,i])); + grpA := grpA - minf1 + 1; + grpB := grpB - minf2 + 1; + grpC := grpC - minf3 + 1; + ncnt[grpA-1,grpB-1,grpC-1] := ncnt[grpA-1,grpB-1,grpC-1] + 1; + wsum[grpA-1,grpB-1,grpC-1] := wsum[grpA-1,grpB-1,grpc-1] + X; + wx2[grpA-1,grpB-1,grpC-1] := wx2[grpA-1,grpB-1,grpC-1] + (X * X); + RowSums[GrpA-1] := RowSums[GrpA-1] + X; + ColSums[GrpB-1] := ColSums[GrpB-1] + X; + SlcSums[GrpC-1] := SlcSums[GrpC-1] + X; + RowCount[GrpA-1] := RowCount[GrpA-1] + 1.0; + ColCount[GrpB-1] := ColCount[GrpB-1] + 1.0; + SlcCount[GrpC-1] := SlcCount[GrpC-1] + 1.0; + MeanDep := MeanDep + X; + SSDep := SSDep + (X * X); + N := N + 1; + end; + + // Calculate results + Constant := (MeanDep * MeanDep) / N; + // get ss for rows + for i := 0 to NoGrpsA-1 do + begin + SSF1 := SSF1 + ((RowSums[i] * RowSums[i]) / RowCount[i]); + RowsTotCnt := RowsTotCnt + RowCount[i]; + end; + SSF1 := SSF1 - Constant; + + // get ss for columns + for j := 0 to NoGrpsB-1 do + begin + SSF2 := SSF2 + ((ColSums[j] * ColSums[j]) / ColCount[j]); + ColsTotCnt := ColsTotCnt + ColCount[j]; + end; + SSF2 := SSF2 - Constant; + + // get ss for slices + for k := 0 to NoGrpsC-1 do + begin + SSF3 := SSF3 + ((SlcSums[k] * SlcSums[k]) / SlcCount[k]); + SlcsTotCnt := SlcsTotCnt + SlcCount[k]; + end; + SSF3 := SSF3 - Constant; + + // get ss for row x col interaction + p := 0.0; + n2 := 0.0; + for i := 0 to NoGrpsA-1 do + begin + for j := 0 to NoGrpsB-1 do + begin + for k := 0 to NoGrpsC-1 do + begin + p := p + wsum[i,j,k]; + n2 := n2 + ncnt[i,j,k]; + end; + SSF1F2 := SSF1F2 + ((p * p) / n2); + p := 0.0; + n2 := 0.0; + end; + end; + SSF1F2 := SSF1F2 - SSF1 - SSF2 - Constant; + + // get ss for row x slice interaction + for i := 0 to NoGrpsA-1 do + begin + for k := 0 to NoGrpsC-1 do + begin + for j := 0 to NoGrpsB-1 do + begin + p := p + wsum[i,j,k]; + n2 := n2 + ncnt[i,j,k]; + end; + SSF1F3 := SSF1F3 + ((p * p) / n2); + p := 0.0; + n2 := 0.0; + end; + end; + SSF1F3 := SSF1F3 - SSF1 - SSF3 - Constant; + + // get ss for columns x slices interaction + for j := 0 to NoGrpsB-1 do + begin + for k := 0 to NoGrpsC-1 do + begin + for i := 0 to NoGrpsA-1 do + begin + p := p + wsum[i,j,k]; + n2 := n2 + ncnt[i,j,k]; + end; + SSF2F3 := SSF2F3 + ((p * p) / n2); + p := 0.0; + n2 := 0.0; + end; + end; + SSF2F3 := SSF2F3 - SSF2 - SSF3 - Constant; + + // get ss for cells + for i := 0 to NoGrpsA-1 do + for j := 0 to NoGrpsB-1 do + for k := 0 to NoGrpsC-1 do + SSCells := SSCells + ((wsum[i,j,k] * wsum[i,j,k]) / ncnt[i,j,k]); + + SSF1F2F3 := SSCells - SSF1 - SSF2 - SSF3 - SSF1F2 - SSF1F3 - SSF2F3 - Constant; + SSErr := SSDep - SSCells; + SSDep := SSDep - Constant; + + if (SSF1 < 0.0) or (SSF2 < 0.0) or (SSF3 < 0.0) or (SSF1F2 < 0.0) or + (SSF1F3 < 0.0) or (SSF2F3 < 0.0) or (SSF1F2F3 < 0.0) then + begin + ShowMessage('ERROR! A negative SS found. Unbalanced Design? Ending analysis.'); + CompError := true; + exit; + end; + DFTot := N - 1; + DFF1 := NoGrpsA - 1; + DFF2 := NoGrpsB - 1; + DFF3 := NoGrpsC - 1; + DFF1F2 := DFF1 * DFF2; + DFF1F3 := DFF1 * DFF3; + DFF2F3 := DFF2 * DFF3; + DFF1F2F3 := DFF1 * DFF2 * DFF3; + DFErr := DFTot - DFF1 - DFF2 - DFF3 - DFF1F2 - DFF1F3 - DFF2F3 - DFF1F2F3; +// DFCells := N - (NoGrpsA * NoGrpsB * NoGrpsC); + MSF1 := SSF1 / DFF1; + MSF2 := SSF2 / DFF2; + MSF3 := SSF3 / DFF3; + MSF1F2 := SSF1F2 / DFF1F2; + MSF1F3 := SSF1F3 / DFF1F3; + MSF2F3 := SSF2F3 / DFF2F3; + MSF1F2F3 := SSF1F2F3 / DFF1F2F3; + MSErr := SSErr / DFErr; + MSDep := SSDep / DFTot; + OmegaF1 := (SSF1 - DFF1 * MSErr) / (SSDep + MSErr); + OmegaF2 := (SSF2 - DFF2 * MSErr) / (SSDep + MSErr); + OmegaF3 := (SSF3 - DFF3 * MSErr) / (SSDep + MSErr); + OmegaF1F2 := (SSF1F2 - DFF1F2 * MSErr) / (SSDep + MSErr); + OmegaF1F3 := (SSF1F3 - DFF1F3 * MSErr) / (SSDep + MSErr); + OmegaF2F3 := (SSF2F3 - DFF2F3 * MSErr) / (SSDep + MSErr); + OmegaF1F2F3 := (SSF1F2F3 - DFF1F2F3 * MSErr) / (SSDep + MSErr); + Omega := OmegaF1 + OmegaF2 + OmegaF3 + OmegaF1F2 + OmegaF1F3 + + OmegaF2F3 + OmegaF1F2F3; + MeanDep := MeanDep / N; + + // f tests for fixed effects + if (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 0) and + (Fact3Grp.ItemIndex = 0) then + begin + FF1 := abs(MSF1 / MSErr); + FF2 := abs(MSF2 / MSErr); + FF3 := abs(MSF3 / MSErr); + FF1F2 := abs(MSF1F2 / MSErr); + FF1F3 := abs(MSF1F3 / MSErr); + FF2F3 := abs(MSF2F3 / MSErr); + FF1F2F3 := abs(MSF1F2F3 / MSErr); + ProbF1 := probf(FF1,DFF1,DFErr); + ProbF2 := probf(FF2,DFF2,DFErr); + ProbF3 := probf(FF3,DFF3,DFErr); + ProbF1F2 := probf(FF1F2,DFF1F2,DFErr); + ProbF1F3 := probf(FF1F3,DFF1F3,DFErr); + ProbF2F3 := probf(FF2F3,DFF2F3,DFErr); + ProbF1F2F3 := probf(FF1F2F3,DFF1F2F3,DFErr); + end; + + // f tests if all factors are random + for i := 1 to 14 do OKterms[i] := 1; // initialize as OK + if (Fact1Grp.ItemIndex = 1) and (Fact2Grp.ItemIndex = 1) and + (Fact3Grp.ItemIndex = 1) then + begin + if (MSF1F2 + MSF1F3 - MSF1F2F3) < 0.0 then OKTerms[1] := 0 else + FF1 := abs(MSF1 / (MSF1F2 + MSF1F3 - MSF1F2F3)); + if (MSF1F2 + MSF2F3 - MSF1F2F3) < 0.0 then OKTerms[2] := 0 else + FF2 := abs(MSF2 / (MSF1F2 + MSF2F3 - MSF1F2F3)); + if (MSF1F3 + MSF2F3 - MSF1F2F3) < 0.0 then OKTerms[3] := 0 else + FF3 := abs(MSF3 / (MSF1F3 + MSF2F3 - MSF1F2F3)); + FF1F2 := abs(MSF1F2 / MSF1F2F3); + FF1F3 := abs(MSF1F3 / MSF1F2F3); + FF2F3 := abs(MSF2F3 / MSF1F2F3); + FF1F2F3 := abs(MSF1F2F3 / MSErr); + ProbF1 := probf(FF1,DFF1,DFF1F2F3); + ProbF2 := probf(FF2,DFF2,DFF1F2F3); + ProbF3 := probf(FF3,DFF3,DFF1F2F3); + ProbF1F2 := probf(FF1F2,DFF1F2,DFF1F2F3); + probF1F3 := probf(FF1F3,DFF1F3,DFF1F2F3); + probF2F3 := probf(FF2F3,DFF2F3,DFF1F2F3); + probF1F2F3 := probf(FF1F2F3,DFF1F2F3,DFErr); + end; + + // f test if factor A is random, B and C Fixed + if (Fact1Grp.ItemIndex = 1) and (Fact2Grp.ItemIndex = 0) and + (Fact3Grp.ItemIndex = 0) then + begin + FF1 := abs(MSF1 / MSErr); + FF2 := abs(MSF2 / MSF1F2); + FF3 := abs(MSF3 / MSF1F3); + FF1F2 := abs(MSF1F2 / MSErr); + FF1F3 := abs(MSF1F3 / MSErr); + FF2F3 := abs(MSF2F3 / MSF1F2F3); + FF1F2F3 := abs(MSF1F2F3 / MSErr); + ProbF1 := probf(FF1,DFF1,DFErr); + ProbF2 := probf(FF2,DFF2,DFF1F2); + ProbF3 := probf(FF3,DFF3,DFF1F3); + ProbF1F2 := probf(FF1F2,DFF1F2,DFErr); + ProbF1F3 := probf(FF1F3,DFF1F3,DFErr); + ProbF2F3 := probf(FF2F3,DFF2F3,DFF1F2F3); + ProbF1F2F3 := probf(FF1F2F3,DFF1F2F3,DFErr); + end; + + // f test if factor b is random and A and C are Fixed + if (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 1) and + (Fact3Grp.ItemIndex = 0) then + begin + FF1 := abs(MSF1 / MSF1F2); + FF2 := abs(MSF2 / MSErr); + FF3 := abs(MSF3 / MSF2F3); + FF1F2 := abs(MSF1F2 / MSErr); + FF1F3 := abs(MSF1F3 / MSF1F2F3); + FF2F3 := abs(MSF2F3 / MSErr); + FF1F2F3 := abs(MSF1F2F3 / MSErr); + ProbF1 := probf(FF1,DFF1,DFF1F2); + ProbF2 := probf(FF2,DFF2,DFErr); + ProbF3 := probf(FF3,DFF3,DFF2F3); + ProbF1F2 := probf(FF1F2,DFF1F2,DFErr); + ProbF1F3 := probf(FF1F3,DFF1F3,DFF1F2F3); + ProbF2F3 := probf(FF2F3,DFF2F3,DFErr); + ProbF1F2F3 := probf(FF1F2F3,DFF1F2F3,DFErr); + end; + + // f test if factor c is random and A and B are Fixed + if (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 0) and + (Fact3Grp.ItemIndex = 1) then + begin + FF1 := abs(MSF1 / MSF1F3); + FF2 := abs(MSF2 / MSF2F3); + FF3 := abs(MSF3 / MSErr); + FF1F2 := abs(MSF1F2 / MSF1F2F3); + FF1F3 := abs(MSF1F3 / MSErr); + FF2F3 := abs(MSF2F3 / MSErr); + FF1F2F3 := abs(MSF1F2F3 / MSErr); + ProbF1 := probf(FF1,DFF1,DFF1F3); + ProbF2 := probf(FF2,DFF2,DFF2F3); + ProbF3 := probf(FF3,DFF3,DFErr); + ProbF1F2 := probf(FF1F2,DFF1F2,DFF1F2F3); + ProbF1F3 := probf(FF1F3,DFF1F3,DFErr); + ProbF2F3 := probf(FF2F3,DFF2F3,DFErr); + ProbF1F2F3 := probf(FF1F2F3,DFF1F2F3,DFErr); + end; + + // f tests if A is fixed, B and C are random + if (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 1) and + (Fact3Grp.ItemIndex = 1) then + begin + if (MSF1F3 + MSF1F2 - MSF1F2F3) < 0.0 then OKTerms[1] := 0 else + FF1 := abs(MSF1 / (MSF1F3 + MSF1F2 - MSF1F2F3)); + FF2 := abs(MSF2 / MSF2F3); + FF3 := abs(MSF3 / MSF2F3); + FF1F2 := abs(MSF1F2 / MSF1F2F3); + FF1F3 := abs(MSF1F3 / MSF1F2F3); + FF2F3 := abs(MSF2F3 / MSErr); + FF1F2F3 := abs(MSF1F2F3 / MSErr); + if (DFF1F3 + DFF1F2 - DFF1F2F3) <= 0 then OKTerms[8] := 0 else + ProbF1 := probf(FF1,DFF1,(DFF1F3 + DFF1F2 - DFF1F2F3)); + ProbF2 := probf(FF2,DFF2,DFF2F3); + ProbF3 := probf(FF3,DFF3,DFF2F3); + ProbF1F2 := probf(FF1F2,DFF1F2,DFF1F2F3); + ProbF1F3 := probf(FF1F3,DFF1F3,DFF1F2F3); + ProbF2F3 := probf(FF2F3,DFF2F3,DFErr); + ProbF1F2F3 := probf(FF1F2F3,DFF1F2F3,DFErr); + end; + // f tests if B is fixed, A and C are random + if (Fact1Grp.ItemIndex = 1) and (Fact2Grp.ItemIndex = 0) and + (Fact3Grp.ItemIndex = 1) then + begin + FF1 := abs(MSF2 / MSF1F3); + if (MSF2F3 + MSF1F2 - MSF1F2F3) <= 0.0 then OKTerms[2] := 0 else + FF2 := abs(MSF1 / (MSF2F3 + MSF1F2 - MSF1F2F3)); + FF3 := abs(MSF3 / MSF1F3); + FF1F2 := abs(MSF1F2 / MSF1F2F3); + FF1F3 := abs(MSF1F3 / MSErr); + FF2F3 := abs(MSF2F3 / MSF1F2F3); + FF1F2F3 := abs(MSF1F2F3 / MSErr); + ProbF1 := probf(FF2,DFF2,DFF1F3); + if (DFF2F3 + DFF1F2 - DFF1F2F3) <= 0 then OKTerms[9] := 0 else + ProbF2 := probf(FF1,DFF1,(DFF2F3 + DFF1F2 - DFF1F2F3)); + ProbF3 := probf(FF3,DFF3,DFF1F3); + ProbF1F2 := probf(FF1F2,DFF1F2,DFF1F2F3); + ProbF1F3 := probf(FF1F3,DFF1F3,DFErr); + ProbF2F3 := probf(FF2F3,DFF2F3,DFF1F2F3); + ProbF1F2F3 := probf(FF1F2F3,DFF1F2F3,DFErr); + end; + + // f tests if C is fixed A and B are random + if (Fact1Grp.ItemIndex = 1) and (Fact2Grp.ItemIndex = 1) and + (Fact3Grp.ItemIndex = 0) then + begin + FF1 := abs(MSF1 / MSF1F2); + FF2 := abs(MSF2 / MSF1F2); + if (MSF2F3 + MSF1F3 - MSF1F2F3) <= 0.0 then OKTerms[3] := 0 else + FF3 := abs(MSF3 / (MSF2F3 + MSF1F3 - MSF1F2F3)); + FF1F2 := abs(MSF2F3 / MSErr); + FF1F3 := abs(MSF1F2 / MSF1F2F3); + FF2F3 := abs(MSF1F3 / MSF1F2F3); + FF1F2F3 := abs(MSF1F2F3 / MSErr); + ProbF1 := probf(FF3,DFF3,DFF1F2); + ProbF2 := probf(FF2,DFF2,DFF1F2); + if (DFF2F3 + DFF1F3 - DFF1F2F3) <= 0 then OKTerms[10] := 0 else + ProbF3 := probf(FF1,DFF1,(DFF2F3 + DFF1F3 - DFF1F2F3)); + ProbF1F2 := probf(FF2F3,DFF2F3,DFErr); + ProbF1F3 := probf(FF1F2,DFF1F2,DFF1F2F3); + ProbF2F3 := probf(FF1F3,DFF1F3,DFF1F2F3); + ProbF1F2F3 := probf(FF1F2F3,DFF1F2F3,DFErr); + end; + if (ProbF1 > 1.0) then ProbF1 := 1.0; + if (ProbF2 > 1.0) then ProbF2 := 1.0; + if ProbF3 > 1.0 then ProbF3 := 1.0; + if (ProbF1F2 > 1.0) then ProbF1F2 := 1.0; + if ProbF1F3 > 1.0 then ProbF1F3 := 1.0; + if ProbF2F3 > 1.0 then ProbF2F3 := 1.0; + if ProbF1F2F3 > 1.0 then ProbF1F2F3 := 1.0; + + // Obtain omega squared (proportion of dependent variable explained) + if (OmegaF1 < 0.0) then OmegaF1 := 0.0; + if (OmegaF2 < 0.0) then OmegaF2 := 0.0; + if OmegaF3 < 0.0 then OmegaF3 := 0.0; + if (OmegaF1F2 < 0.0) then OmegaF1F2 := 0.0; + if OmegaF1F3 < 0.0 then OmegaF1F3 := 0.0; + if OmegaF2F3 < 0.0 then OmegaF2F3 := 0.0; + if OmegaF1F2F3 < 0.0 then OmegaF1F2F3 := 0.0; + if (Omega < 0.0) then Omega := 0.0; +end; + +procedure TBlksAnovaFrm.ThreeWayTable(AReport: TStrings); +var + groupsize: integer; + MinVar, MaxVar, sumvars, sumDFrecip: double; + i, j, k: integer; + XBar, V, S, RowSS, ColSS, SlcSS: double; + sumfreqlogvar, c, bartlett, cochran, hartley, chiprob: double; + problem: boolean; +begin + if CompError then + exit; + + problem := false; + AReport.Add('Three Way Analysis of Variance'); + AReport.Add(''); + AReport.Add('Variable analyzed: %s', [DepVar.Text]); + AReport.Add(''); + + outline := format('Factor A (rows) variable: %s', [Factor1.Text]); + if Fact1Grp.ItemIndex = 0 then + outline := outline + ' (Fixed Levels)' + else + outline := outline + ' (Random Levels)'; + AReport.Add(outline); + + outline := format('Factor B (columns) variable: %s', [Factor2.Text]); + if Fact2Grp.ItemIndex = 0 then + outline := outline + ' (Fixed Levels)' + else + outline := outline + ' (Random Levels)'; + AReport.Add(outline); + + outline := format('Factor C (slices) variable: %s', [Factor3.Text]); + if Fact3Grp.ItemIndex = 0 then + outline := outline + ' (Fixed Levels)' + else + outline := outline + ' (Random Levels)'; + AReport.Add(outline); + AReport.Add(''); + + AReport.Add('SOURCE D.F. SS MS F PROB.> F Omega Squared'); + AReport.Add(''); + if (OKTerms[1] = 1) and (OKTerms[8] = 1) then + AReport.Add('Among Rows %4.0f %10.3f %10.3f %10.3f %6.3f %6.3f', [DFF1, SSF1, MSF1, FF1, ProbF1, OmegaF1]) + else + AReport.Add('Among Rows %4.0f %10.3f %10.3f --- error ---', [DFF1, SSF1, MSF1 ]); + + if (OKTerms[2] = 1) and (OKTerms[9] = 1) then + AReport.Add('Among Columns %4.0f %10.3f %10.3f %10.3f %6.3f %6.3f', [DFF2, SSF2, MSF2, FF2, ProbF2, OmegaF2]) + else + AReport.Add('Among Columns %4.0f %10.3f %10.3f --- error ---', [DFF2, SSF2, MSF2]); + + if (OKTerms[3] = 1) and (OKTerms[10] = 1) then + AReport.Add('Among Slices %4.0f %10.3f %10.3f %10.3f %6.3f %6.3f', [DFF3, SSF3, MSF3, FF3, ProbF3, OmegaF3]) + else + AReport.Add('Among Slices %4.0f %10.3f %10.3f --- error ---', [DFF3, SSF3, MSF3]); + + AReport.Add('A x B Inter. %4.0f %10.3f %10.3f %10.3f %6.3f %6.3f', [DFF1F2, SSF1F2, MSF1F2, FF1F2, ProbF1F2, OmegaF1F2]); + AReport.Add('A x C Inter. %4.0f %10.3f %10.3f %10.3f %6.3f %6.3f', [DFF1F3, SSF1F3, MSF1F3, FF1F3, ProbF1F3, OmegaF1F3]); + AReport.Add('B x C Inter. %4.0f %10.3f %10.3f %10.3f %6.3f %6.3f', [DFF2F3, SSF2F3, MSF2F3, FF2F3, ProbF2F3, OmegaF2F3]); + AReport.Add('AxBxC Inter. %4.0f %10.3f %10.3f %10.3f %6.3f %6.3f', [DFF1F2F3, SSF1F2F3, MSF1F2F3, FF1F2F3, ProbF1F2F3, OmegaF1F2F3]); + AReport.Add('Within Groups %4.0f %10.3f %10.3f', [DFErr, SSErr, MSErr]); + AReport.Add('Total %4.0f %10.3f %10.3f', [DFTot, SSDep, MSDep]); + AReport.Add(''); + AReport.Add('Omega squared for combined effects = %8.3f', [Omega]); + AReport.Add(''); + if (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 0) and (Fact3Grp.ItemIndex = 0) then + AReport.Add('Note: MSErr denominator for all F ratios.'); + if (Fact1Grp.ItemIndex = 1) and (Fact2Grp.ItemIndex = 1) and (Fact3Grp.ItemIndex = 1) then + begin + AReport.Add('Note: Error term for A is MSAxB + MSAxC - MSAxBxC'); + AReport.Add('Error term for B is MSAxB + MSBxC - MSAxBxC'); + AReport.Add('Error term for C is MSAxC + MSBxC - MSAxBxC'); + AReport.Add('Error term for AxB, AxC and BxC is MSAxBxC'); + AReport.Add('Error term for AxBxC is MSErr.'); + end; + if (Fact1Grp.ItemIndex = 1) and (Fact2Grp.ItemIndex = 0) and (Fact3Grp.ItemIndex = 0) then + begin + AReport.Add('Note: Error term for A is MSErr'); + AReport.Add('Note: Error term for B is MSAxB'); + AReport.Add('Note: Error term for C is MSAxC'); + AReport.Add('Note: Error term for AxB is MSErr'); + AReport.Add('Note: Error term for AxC is MSErr'); + AReport.Add('Note: Error term for BxC is MSAxBxC'); + AReport.Add('Note: Error term for AxBxC is MSErr'); + end; + if (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 1) and (Fact3Grp.ItemIndex = 0) then + begin + AReport.Add('Note: Error term for A is MSAxB'); + AReport.Add('Note: Error term for B is MSErr'); + AReport.Add('Note: Error term for C is MSBxC'); + AReport.Add('Note: Error term for AxB is MSErr'); + AReport.Add('Note: Error term for AxC is MSAxBxC'); + AReport.Add('Note: Error term for BxC is MSErr'); + AReport.Add('Note: Error term for AxBxC is MSErr'); + end; + if (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 0) and (Fact3Grp.ItemIndex = 1) then + begin + AReport.Add('Note: Error term for A is MSAxC'); + AReport.Add('Note: Error term for B is MSBxC'); + AReport.Add('Note: Error term for C is MSErr'); + AReport.Add('Note: Error term for AxB is MSAxBxC'); + AReport.Add('Note: Error term for AxC is MSErr'); + AReport.Add('Note: Error term for BxC is MSErr'); + AReport.Add('Note: Error term for AxBxC is MSErr'); + end; + if (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 1) and (Fact3Grp.ItemIndex = 1) then + begin + AReport.Add('Note: Error term for A is MSAxC + MSAxB - MSAxBxC'); + AReport.Add('Note: Error term for B is MSBxC'); + AReport.Add('Note: Error term for C is MSBxC'); + AReport.Add('Note: Error term for AxB is MSAxBxC'); + AReport.Add('Note: Error term for AxC is MSAxBxC'); + AReport.Add('Note: Error term for BxC is MSErr'); + AReport.Add('Note: Error term for AxBxC is MSErr'); + end; + if (Fact1Grp.ItemIndex = 1) and (Fact2Grp.ItemIndex = 0) and (Fact3Grp.ItemIndex = 1) then + begin + AReport.Add('Note: Error term for A is MSAxC'); + AReport.Add('Note: Error term for B is MSBxC + MSAxB - MSAxBxC'); + AReport.Add('Note: Error term for C is MSAxC'); + AReport.Add('Note: Error term for AxB is MSAxBxC'); + AReport.Add('Note: Error term for AxC is MSErr'); + AReport.Add('Note: Error term for BxC is MSAxBxC'); + AReport.Add('Note: Error term for AxBxC is MSErr'); + end; + if (Fact1Grp.ItemIndex = 1) and (Fact2Grp.ItemIndex = 1) and (Fact3Grp.ItemIndex = 0) then + begin + AReport.Add('Note: Error term for A is MSAxB'); + AReport.Add('Note: Error term for B is MSAxB'); + AReport.Add('Note: Error term for C is MSBxC + MSAxC - MSAxBxC'); + AReport.Add('Note: Error term for AxB is MSErr'); + AReport.Add('Note: Error term for AxC is MSAxBxC'); + AReport.Add('Note: Error term for BxC is MSAxBxC'); + AReport.Add('Note: Error term for AxBxC is MSErr'); + end; + AReport.Add(''); + + for i := 1 to 10 do + if OKTerms[i] = 0 then problem := true; + if problem then + begin + AReport.Add('An error occurred due to either an estimate of MS being negative'); + AReport.Add('or the degrees of freedom being zero. This may occur in a design'); + AReport.Add('with random factors using the expected values for an exact F-test.'); + AReport.Add('Quasi-F statistics may be employed where this problem exists. See'); + AReport.Add('Winer, B.J., "Statistical Principles in Experimental Design, 1962'); + AReport.Add('Section 5.15, pages 199-202 and Glass, G.V. and Stanley, J.C.,'); + AReport.Add('1970, Section 18.10, pages 481-482.'); + end; + + AReport.Add(''); + AReport.Add('Descriptive Statistics'); + AReport.Add(''); + AReport.Add('GROUP N MEAN VARIANCE STD.DEV.'); + + groupsize := ncnt[1,1,1]; + equal_grp := true; + MaxVar := 0.0; + MinVar := 1e20; + sumvars := 0.0; + sumfreqlogvar := 0.0; + sumDFrecip := 0.0; + + // Display cell means, variances, standard deviations + for i := 0 to NoGrpsA-1 do + begin + for j := 0 to NoGrpsB-1 do + begin + for k := 0 to NoGrpsC-1 do + begin + XBar := wsum[i,j,k] / ncnt[i,j,k]; + V := wx2[i,j,k] - ( (wsum[i,j,k] * wsum[i,j,k]) / ncnt[i,j,k]); + V := V / (ncnt[i,j,k] - 1.0); + S := sqrt(V); + sumvars := sumvars + V; + if V > MaxVar then MaxVar := V; + if V < MinVar then MinVar := V; + sumDFrecip := sumDFrecip + (1.0 / (ncnt[i,j,k] - 1.0)); + sumfreqlogvar := sumfreqlogvar + ((ncnt[i,j,k] - 1.0) * ln(V)); + if ncnt[i,j,k] <> groupsize then equal_grp := false; + AReport.Add('Cell %3d %3d %3d %3d %8.3f %8.3f %8.3f', [minf1+i, minf2+j, minf3+k, ncnt[i,j,k], XBar, V, S]); + end; + end; + end; + + //Display Row means, variances, standard deviations + for i := 0 to NoGrpsA-1 do + begin + XBar := RowSums[i] / RowCount[i]; + OrdMeansA[i] := XBar; + RowSS := 0.0; + for j := 0 to NoGrpsB-1 do + for k := 0 to NoGrpsC-1 do RowSS := RowSS + wx2[i,j,k]; + V := RowSS - (RowSums[i] * RowSums[i] / RowCount[i]); + V := V / (RowCount[i] - 1.0); + S := sqrt(V); + AReport.Add('Row %3d %3.0f %8.3f %8.3f %8.3f', [minf1+i, RowCount[i], XBar, V, S]); + end; + + //Display means, variances and standard deviations for columns + for j := 0 to NoGrpsB-1 do + begin + XBar := ColSums[j] / ColCount[j]; + OrdMeansB[j] := XBar; + ColSS := 0.0; + for i := 0 to NoGrpsA-1 do + for k := 0 to NoGrpsC-1 do ColSS := ColSS + wx2[i,j,k]; + V := ColSS - (ColSums[j] * ColSums[j] / ColCount[j]); + V := V / (ColCount[j] - 1.0); + S := sqrt(V); + AReport.Add('Col %3d %3.0f %8.3f %8.3f %8.3f', [minf2+j, ColCount[j], XBar, V, S]); + end; + + //Display means, variances and standard deviations for slices + for k := 0 to NoGrpsC-1 do + begin + XBar := SlcSums[k] / SlcCount[k]; + OrdMeansC[k] := XBar; + SlcSS := 0.0; + for i := 0 to NoGrpsA-1 do + for j := 0 to NoGrpsB-1 do SlcSS := SlcSS + wx2[i,j,k]; + V := SlcSS - (SlcSums[k] * SlcSums[k] / SlcCount[k]); + V := V / (SlcCount[k] - 1.0); + S := sqrt(V); + AReport.Add('Slice %3d %3.0f %8.3f %8.3f %8.3f', [minf3+k, SlcCount[k], XBar, V, S]); + end; + + AReport.ADd('TOTAL %3d %8.3f %8.3f %8.3f', [N, MeanDep, MSDep, sqrt(MSDep)]); + AReport.Add(''); + AReport.Add(''); + + c := 1.0 + (1.0 / (3.0 * NoGrpsA * NoGrpsB * NoGrpsC - 1.0)) * (sumDFrecip - (1.0 / DFErr)); + bartlett := (2.303 / c) * ((DFErr * ln(MSErr)) - sumfreqlogvar); + chiprob := chisquaredprob(bartlett,round(NoGrpsA * NoGrpsB * NoGrpsC - 1)); + cochran := maxvar / sumvars; + hartley := maxvar / minvar; + AReport.Add('TESTS FOR HOMOGENEITY OF VARIANCE'); + AReport.Add('---------------------------------------------------------------------'); + AReport.Add('Hartley Fmax test statistic = %.2f with deg.s freedom: %d and %d.', [hartley, NoGrpsA*NoGrpsB, groupsize-1]); + AReport.Add(outline); + AReport.Add('Cochran C statistic = %.2f with deg.s freedom: %d and %d.', [cochran, NoGrpsA*NoGrpsB, groupsize - 1]); + AReport.Add('Bartlett Chi-square statistic = %.2f with %d D.F. Prob. larger = %.3f', [bartlett, NoGrpsA*NoGrpsB - 1, 1.0 - chiprob]); + AReport.Add('---------------------------------------------------------------------'); +end; + +procedure TBlksAnovaFrm.ThreeWayPlot; +var + i, j, k : integer; + maxmean, XBar : double; + XValue : DblDyneVec; + title : string; + plottype : integer; + setstring : string[11]; + +begin + if CompError then exit; + SetLength(XValue,totcells); + plottype := 2; + if PlotMeans.Checked then plottype := 2; + if Plot2DLines.Checked then plottype := 5; + if Plot3DLines.Checked then plottype := 6; + + // do Factor A first + setstring := 'FACTOR A'; + GraphFrm.SetLabels[1] := setstring; + maxmean := 0.0; + SetLength(GraphFrm.Xpoints,1,NF1cells); + SetLength(GraphFrm.Ypoints,1,NF1cells); + for i := 0 to NF1cells-1 do + begin + RowSums[i] := RowSums[i] / RowCount[i]; + GraphFrm.Ypoints[0,i] := RowSums[i]; + if RowSums[i] > maxmean then maxmean := RowSums[i]; + XValue[i] := minF1 + i; + GraphFrm.Xpoints[0,i] := XValue[i]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NF1cells; + GraphFrm.Heading := Factor1.Text; + title := Factor1.Text + ' Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + + // do Factor B next + setstring := 'FACTOR B'; + GraphFrm.SetLabels[1] := setstring; + maxmean := 0.0; + SetLength(GraphFrm.Xpoints,1,NF2cells); + SetLength(GraphFrm.Ypoints,1,NF2cells); + for i := 0 to NF2cells-1 do + begin + ColSums[i] := ColSums[i] / ColCount[i]; + GraphFrm.Ypoints[0,i] := ColSums[i]; + if ColSums[i] > maxmean then maxmean := ColSums[i]; + XValue[i] := minF2 + i; + GraphFrm.Xpoints[0,i] := XValue[i]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NF2cells; + GraphFrm.Heading := Factor2.Text; + title := Factor2.Text + ' Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + + // do Factor C next + setstring := 'FACTOR C'; + GraphFrm.SetLabels[1] := setstring; + maxmean := 0.0; + SetLength(GraphFrm.Xpoints,1,NF3cells); + SetLength(GraphFrm.Ypoints,1,NF3cells); + for i := 0 to NF3cells-1 do + begin + SlcSums[i] := SlcSums[i] / SlcCount[i]; + GraphFrm.Ypoints[0,i] := SlcSums[i]; + if SlcSums[i] > maxmean then maxmean := SlcSums[i]; + XValue[i] := minF3 + i; + GraphFrm.Xpoints[0,i] := XValue[i]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NF3cells; + GraphFrm.Heading := Factor3.Text; + title := Factor2.Text + ' Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + + // do Factor A x B Interaction within each slice next + SetLength(GraphFrm.Ypoints,NF1cells,NF2cells); + SetLength(GraphFrm.Xpoints,1,NF2cells); + for k := 0 to NF3cells-1 do + begin + maxmean := 0.0; + for i := 0 to NF1cells-1 do + begin + setstring := Factor1.Text + ' ' + IntToStr(i+1); + GraphFrm.SetLabels[i+1] := setstring; + for j := 0 to NF2cells-1 do + begin + XBar := wsum[i,j,k] / ncnt[i,j,k]; + if XBar > maxmean then maxmean := XBar; + GraphFrm.Ypoints[i,j] := XBar; + end; + end; + for j := 0 to NF2cells-1 do + begin + XValue[j] := minF2 + j ; + GraphFrm.Xpoints[0,j] := XValue[j]; + end; + + GraphFrm.nosets := NF1cells; + GraphFrm.nbars := NF2cells; + GraphFrm.Heading := 'Factor A x Factor B Within Slice' + IntToStr(k); + title := Factor2.Text + ' Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; + + // do Factor A x C Interaction within each Column next + SetLength(GraphFrm.Ypoints,NF1cells,NF3cells); + SetLength(GraphFrm.Xpoints,1,NF3cells); + for j := 0 to NF2cells-1 do + begin + maxmean := 0.0; + for i := 0 to NF1cells-1 do + begin + setstring := Factor1.Text + ' ' + IntToStr(i+1); + GraphFrm.SetLabels[i+1] := setstring; + for k := 0 to NF3cells-1 do + begin + XBar := wsum[i,j,k] / ncnt[i,j,k]; + if XBar > maxmean then maxmean := XBar; + GraphFrm.Ypoints[i,k] := XBar; + end; + end; + for k := 0 to NF3cells-1 do + begin + XValue[k] := minF3 + k; + GraphFrm.Xpoints[0,k] := XValue[k]; + end; + + GraphFrm.nosets := NF1cells; + GraphFrm.nbars := NF3cells; + GraphFrm.Heading := 'Factor A x Factor C Within Column ' + IntToStr(j+1); + title := Factor3.Text + ' Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; + + // do Factor B x C Interaction within each row next + SetLength(GraphFrm.Ypoints,NF2cells,NF3cells); + SetLength(GraphFrm.Xpoints,1,NF3cells); + for i := 0 to NF1cells-1 do + begin + maxmean := 0.0; + for j := 0 to NF2cells-1 do + begin + setstring := Factor2.Text + ' ' + IntToStr(j+1); + GraphFrm.SetLabels[j+1] := setstring; + for k := 0 to NF3cells-1 do + begin + XBar := wsum[i,j,k] / ncnt[i,j,k]; + if XBar > maxmean then maxmean := XBar; + GraphFrm.Ypoints[j,k] := XBar; + end; + end; + for j := 0 to NF2cells-1 do + begin + XValue[j] := minF2 + j; + GraphFrm.Xpoints[0,j] := XValue[j]; + end; + + GraphFrm.nosets := NF2cells; + GraphFrm.nbars := NF3cells; + GraphFrm.Heading := 'Factor B x Factor C Within Row ' + IntToStr(i+1); + title := Factor3.Text + ' Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; // next row + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + XValue := nil; +end; +//------------------------------------------------------------------- +procedure TBlksAnovaFrm.TwoWayContrasts(AReport: TStrings); +var + i, j : integer; + value : double; + variances : DblDyneVec; + RowSS, ColSS : double; + +begin + if CompError then + exit; + + SetLength(variances,totcells); + + // Do row comparisons + if (NF1cells > 2) then + if ProbF1 < allAlpha then + if Fact2Grp.ItemIndex = 0 then + begin + for i := 0 to NoGrpsA-1 do + begin + RowSS := 0.0; + for j := 0 to NoGrpsB-1 do RowSS := RowSS + vars[i,j]; + variances[i] := RowSS - (RowSums[i] * RowSums[i] / RowCount[i]); + variances[i] := variances[i] / (RowCount[i] - 1.0); + end; + + AReport.Add(''); + AReport.Add('COMPARISONS AMONG ROWS'); + + // get smallest group size + value := 1e308; + for i := 0 to NF1cells-1 do if RowCount[i] < value then value := RowCount[i]; + if Scheffe.Checked then + ScheffeTest(MSErr, RowSums, RowCount, minf1, maxf1, N, posthocAlpha, AReport); + if TukeyHSD.Checked and equal_grp then + Tukey(MSErr, DFErr, value, RowSums, RowCount, minf1, maxf1, posthocAlpha, AReport); + if TukeyB.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, RowSums, RowCount, minf1, maxf1, value, posthocAlpha, AReport); + if TukeyKramer.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, RowSums, RowCount, minf1, maxf1, posthocAlpha, AReport); + if NewmanKeuls.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, RowSums, RowCount, minf1, maxf1, posthocAlpha, AReport); + if Bonferoni.Checked then + Bonferroni(RowSums, RowCount, variances, minf1, maxf1, posthocAlpha, AReport); + if OrthoContrasts.Checked then + Contrasts(MSErr, DFErr, RowSums, RowCount, minf1, maxf1, AllAlpha, AReport); + end; + + // Do column comparisons + if (NF2cells > 2) and (ProbF2 < allAlpha) and (Fact2Grp.ItemIndex = 0) then + begin + for j := 0 to NoGrpsB-1 do + begin + ColSS := 0.0; + for i := 0 to NoGrpsA-1 do ColSS := ColSS + vars[i,j]; + variances[j] := ColSS - (ColSums[j] * ColSums[j] / ColCount[j]); + variances[j] := variances[j] / (ColCount[j] - 1.0); + end; + AReport.Add(''); + AReport.Add('COMPARISONS AMONG COLUMNS'); + value := 1e20; + for i := 0 to NF2cells-1 do + if ColCount[i] < value then value := ColCount[i]; + if Scheffe.Checked then + ScheffeTest(MSErr, ColSums, ColCount, minf2, maxf2, N, posthocAlpha, AReport); + if TukeyHSD.Checked and equal_grp then + Tukey(MSErr, DFErr, value, ColSums, ColCount, minf2, maxf2, posthocAlpha, AReport); + if TukeyB.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, ColSums, ColCount, minf2, maxf2, value, posthocAlpha, AReport); + if TukeyKramer.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, ColSums, ColCount, minf2, maxf2, posthocAlpha, AReport); + if NewmanKeuls.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, ColSums, ColCount, minf2, maxf2, posthocAlpha, AReport); + if Bonferoni.Checked then + Bonferroni(ColSums, ColCount, variances, minf2, maxf2, posthocAlpha, AReport); + if OrthoContrasts.Checked then + Contrasts(MSErr, DFErr, ColSums, ColCount, minf2, maxf2, AllAlpha, AReport); + end; + + // do simple effects for columns within each row + if (ProbF3 < allAlpha) and (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 0) then + begin + AReport.Add(''); + AReport.Add('COMPARISONS AMONG COLUMNS WITHIN EACH ROW'); + for i := 0 to NF1cells-1 do + begin + AReport.Add(''); + AReport.Add('ROW %d COMPARISONS',[i+1]); + // move cell sums and counts to cellsums and cellcnts + for j := 0 to NF2cells-1 do + begin + cellsums[j] := sums[i,j]; + cellcnts[j] := counts[i,j]; + cellvars[j] := vars[i,j]; + end; + value := 1e308; + for j := 0 to NF2cells-1 do + if cellcnts[j] < value then value := cellcnts[j]; + if Scheffe.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf2, maxf2, N, posthocAlpha, AReport); + if TukeyHSD.Checked and equal_grp then + Tukey(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if TukeyB.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf2, maxf2, value, posthocAlpha, AReport); + if TukeyKramer.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if NewmanKeuls.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if Bonferoni.Checked then + Bonferroni(cellsums, cellcnts, cellvars, minf2, maxf2, posthocAlpha, AReport); + if OrthoContrasts.Checked then + Contrasts(MSErr, DFErr, cellsums, cellcnts, minf2, maxf2, 0.05, AReport); + end; + end; + + // do simple effects for rows within each column + if (ProbF3 < allAlpha) and (Fact1Grp.ItemIndex = 0) and (Fact2Grp.ItemIndex = 0) then + begin + AReport.Add(''); + AReport.Add('COMPARISONS AMONG ROWS WITHIN EACH COLUMN'); + for j := 0 to NF2cells-1 do + begin + AReport.Add(''); + AReport.Add('COLUMN %d COMPARISONS', [j+1]); + // move cell sums and counts to cellsums and cellcnts + for i := 0 to NF1cells-1 do + begin + cellsums[i] := sums[i,j]; + cellcnts[i] := counts[i,j]; + cellvars[i] := vars[i,j]; + end; + value := 1e308; + for i := 0 to NF1cells-1 do + if cellcnts[j] < value then value := cellcnts[j]; + if Scheffe.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf1, maxf1, N, posthocAlpha, AReport); + if TukeyHSD.Checked and equal_grp then + Tukey(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + if TukeyB.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf1, maxf1, value, posthocAlpha, AReport); + if TukeyKramer.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + if NewmanKeuls.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + if Bonferoni.Checked then + Bonferroni(cellsums, cellcnts, cellvars, minf1, maxf1, posthocAlpha, AReport); + if OrthoContrasts.Checked then + Contrasts(MSErr, DFErr, cellsums, cellcnts, minf1, maxf1, 0.05, AReport); + end; + end; + variances := nil; +end; + +procedure TBlksAnovaFrm.ThreeWayContrasts(AReport: TStrings); +var + i, j, k : integer; + value : double; + variances : DblDyneVec; + RowSS, ColSS, SlcSS : double; + +begin + if CompError then + exit; + + if (Scheffe.Checked = false) and (TukeyHSD.Checked = false) and + (TukeyB.Checked = false) and (TukeyKramer.Checked = false) and + (NewmanKeuls.Checked = false) and (Bonferoni.Checked = false) and + (OrthoContrasts.Checked = false) then exit; + SetLength(variances,totcells); + + // Do row comparisons + if (NF1cells > 2) and (ProbF1 < allAlpha) then + begin + for i := 0 to NoGrpsA-1 do + begin + RowSS := 0.0; + for j := 0 to NoGrpsB-1 do + for k := 0 to NoGrpsC-1 do RowSS := RowSS + wx2[i,j,k]; + variances[i] := RowSS - (RowSums[i] * RowSums[i] / RowCount[i]); + variances[i] := variances[i] / (RowCount[i] - 1.0); + end; + AReport.Add(''); + AReport.Add('COMPARISONS AMONG ROWS'); + // get smallest group size + value := 1e20; + for i := 0 to NF1cells-1 do if RowCount[i] < value then value := RowCount[i]; + if Scheffe.Checked then + ScheffeTest(MSErr, RowSums, RowCount, minf1, maxf1, N, posthocAlpha, AReport); + if TukeyHSD.Checked and equal_grp then + Tukey(MSErr, DFErr, value, RowSums, RowCount, minf1, maxf1, posthocAlpha, AReport); + if TukeyB.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, RowSums, RowCount, minf1, maxf1, value, posthocAlpha, AReport); + if TukeyKramer.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, RowSums, RowCount, minf1, maxf1, posthocAlpha, AReport); + if NewmanKeuls.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, RowSums, RowCount, minf1, maxf1, posthocAlpha, AReport); + if Bonferoni.Checked then + Bonferroni(RowSums, RowCount, variances, minf1, maxf1, posthocAlpha, AReport); + if OrthoContrasts.Checked then + Contrasts(MSErr, DFErr, RowSums, RowCount, minf1, maxf1, AllAlpha, AReport); + end; + + // Do column comparisons + if (NF2cells > 2) and (ProbF2 < allAlpha) then + begin + for j := 0 to NoGrpsB-1 do + begin + ColSS := 0.0; + for i := 0 to NoGrpsA-1 do + for k := 0 to NoGrpsC-1 do ColSS := ColSS + wx2[i,j,k]; + variances[j] := ColSS - (ColSums[j] * ColSums[j] / ColCount[j]); + variances[j] := variances[j] / (ColCount[j] - 1.0); + end; + AReport.Add(''); + AReport.Add('COMPARISONS AMONG COLUMNS'); + value := 1e308; + for i := 0 to NF2cells-1 do + if ColCount[i] < value then value := ColCount[i]; + if Scheffe.Checked then + ScheffeTest(MSErr, ColSums, ColCount, minf2, maxf2, N, posthocAlpha, AReport); + if TukeyHSD.Checked and equal_grp then + Tukey(MSErr, DFErr, value, ColSums, ColCount, minf2, maxf2, posthocAlpha, AReport); + if TukeyB.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, ColSums, ColCount, minf2, maxf2, value, posthocAlpha, AReport); + if TukeyKramer.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, ColSums, ColCount, minf2, maxf2, posthocAlpha, AReport); + if NewmanKeuls.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, ColSums, ColCount, minf2, maxf2, posthocAlpha, AReport); + if Bonferoni.Checked then + Bonferroni(ColSums, ColCount, variances, minf2, maxf2, posthocAlpha, AReport); + if OrthoContrasts.Checked then + Contrasts(MSErr, DFErr, ColSums, ColCount, minf2, maxf2, AllAlpha, AReport); + end; + + // Do slice comparisons + if (NF3cells > 2) and (ProbF3 < allAlpha) then + begin + for k := 0 to NoGrpsC-1 do + begin + SlcSS := 0.0; + for i := 0 to NoGrpsA-1 do + for j := 0 to NoGrpsB-1 do SlcSS := SlcSS + wx2[i,j,k]; + variances[k] := SlcSS - (SlcSums[k] * SlcSums[k] / SlcCount[k]); + variances[k] := variances[k] / (SlcCount[k] - 1.0); + end; + AReport.Add(''); + AReport.Add('COMPARISONS AMONG SLICES'); + value := 1e308; + for i := 0 to NF3cells-1 do + if SlcCount[i] < value then value := SlcCount[i]; + if Scheffe.Checked then + ScheffeTest(MSErr, SlcSums, SlcCount, minf3, maxf3, N, posthocAlpha, AReport); + if TukeyHSD.Checked and equal_grp then + Tukey(MSErr, DFErr, value, SlcSums, SlcCount, minf3, maxf3, posthocAlpha, AReport); + if TukeyB.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, SlcSums, SlcCount, minf3, maxf3, value, posthocAlpha, AReport); + if TukeyKramer.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, SlcSums, SlcCount, minf3, maxf3, posthocAlpha, AReport); + if NewmanKeuls.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, SlcSums, SlcCount, minf3, maxf3, posthocAlpha, AReport); + if Bonferoni.Checked then + Bonferroni(SlcSums, SlcCount, variances, minf3, maxf3, posthocAlpha, AReport); + if OrthoContrasts.Checked then + Contrasts(MSErr, DFErr, SlcSums, SlcCount, minf3, maxf3, AllAlpha, AReport); + end; + + // do simple effects for columns within each row + if (ProbF1f2 < allAlpha) then + begin + AReport.Add(''); + AReport.Add('COMPARISONS AMONG COLUMNS WITHIN EACH ROW'); + for i := 0 to NF1cells-1 do + begin + AReport.Add(''); + AReport.Add('ROW %d COMPARISONS',[i+1]); + // move cell sums and counts to cellsums and cellcnts + for j := 0 to NF2cells-1 do + begin + for k := 0 to NF3cells-1 do + begin + cellsums[j] := wsum[i,j,k]; + cellcnts[j] := ncnt[i,j,k]; + cellvars[j] := wx2[i,j,k]; + end; + end; + value := 1e308; + for j := 0 to NF2cells-1 do + if cellcnts[j] < value then value := cellcnts[j]; + if Scheffe.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf2, maxf2, N, posthocAlpha, AReport); + if TukeyHSD.Checked and equal_grp then + Tukey(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if TukeyB.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf2, maxf2, value, posthocAlpha, AReport); + if TukeyKramer.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if NewmanKeuls.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if Bonferoni.Checked then + Bonferroni(cellsums, cellcnts, cellvars, minf2, maxf2, posthocAlpha, AReport); + if OrthoContrasts.Checked then + Contrasts(MSErr, DFErr, cellsums, cellcnts, minf2, maxf2, 0.05, AReport); + end; + end; + + // do simple effects for rows within each column + if (ProbF1f2 < allAlpha) then + begin + AReport.Add(''); + AReport.Add('COMPARISONS AMONG ROWS WITHIN EACH COLUMN'); + for j := 0 to NF2cells-1 do + begin + AReport.Add(''); + AReport.Add('COLUMN %d COMPARISONS', [j+1]); + // move cell sums and counts to cellsums and cellcnts + for i := 0 to NF1cells-1 do + begin + for k := 0 to NF3cells-1 do + begin + cellsums[i] := wsum[i,j,k]; + cellcnts[i] := ncnt[i,j,k]; + cellvars[i] := wx2[i,j,k]; + end; + end; + value := 1e308; + for i := 0 to NF1cells-1 do + if cellcnts[j] < value then value := cellcnts[j]; + if Scheffe.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf1, maxf1, N, posthocAlpha, AReport); + if TukeyHSD.Checked and equal_grp then + Tukey(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + if TukeyB.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf1, maxf1, value, posthocAlpha, AReport); + if TukeyKramer.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + if NewmanKeuls.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + if Bonferoni.Checked then + Bonferroni(cellsums, cellcnts, cellvars, minf1, maxf1, posthocAlpha, AReport); + if OrthoContrasts.Checked then + Contrasts(MSErr, DFErr, cellsums, cellcnts, minf1, maxf1, 0.05, AReport); + end; + end; + + // do simple effects for columns within each slice + if (ProbF2F3 < allAlpha) then + begin + AReport.Add(''); + AReport.Add('COMPARISONS AMONG COLUMNS WITHIN EACH SLICE'); + for k := 0 to NF3cells-1 do + begin + AReport.Add(''); + AReport.Add('SLICE %d COMPARISONS',[k+1]); + // move cell sums and counts to cellsums and cellcnts + for j := 0 to NF2cells-1 do + begin + for i := 0 to NF1cells-1 do + begin + cellsums[j] := wsum[i,j,k]; + cellcnts[j] := ncnt[i,j,k]; + cellvars[j] := wx2[i,j,k]; + end; + end; + value := 1e20; + for j := 1 to NF2cells do if cellcnts[j] < value then value := cellcnts[j]; + if Scheffe.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf2, maxf2, N, posthocAlpha, AReport); + if TukeyHSD.Checked and equal_grp then + Tukey(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if TukeyB.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf2, maxf2, value, posthocAlpha, AReport); + if TukeyKramer.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if NewmanKeuls.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if Bonferoni.Checked then + Bonferroni(cellsums, cellcnts, cellvars, minf2, maxf2, posthocAlpha, AReport); + if OrthoContrasts.Checked then + Contrasts(MSErr, DFErr, cellsums, cellcnts, minf2, maxf2, 0.05, AReport); + end; + end; + + // do simple effects for rows within each slice + if (ProbF1F3 < allAlpha) then + begin + AReport.Add(''); + AReport.Add('COMPARISONS AMONG ROWS WITHIN EACH SLICE'); + for k := 0 to NF3cells-1 do + begin + AReport.Add(''); + AReport.Add('SLICE %d COMPARISONS',[k+1]); + // move cell sums and counts to cellsums and cellcnts + for i := 0 to NF1cells-1 do + begin + for j := 0 to NF2cells-1 do + begin + cellsums[j] := wsum[i,j,k]; + cellcnts[j] := ncnt[i,j,k]; + cellvars[j] := wx2[i,j,k]; + end; + end; + value := 1e20; + for i := 0 to NF1cells-1 do if cellcnts[i] < value then value := cellcnts[i]; + if Scheffe.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf1, maxf1, N, posthocAlpha, AReport); + if TukeyHSD.Checked and equal_grp then + Tukey(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + if TukeyB.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf1, maxf1, value, posthocAlpha, AReport); + if TukeyKramer.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + if NewmanKeuls.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + if Bonferoni.Checked then + Bonferroni(cellsums, cellcnts, cellvars, minf1, maxf1, posthocAlpha, AReport); + if OrthoContrasts.Checked then + Contrasts(MSErr, DFErr, cellsums, cellcnts, minf1, maxf1, 0.05, AReport); + end; + end; + variances := nil +end; + +//------------------------------------------------------------------- +procedure TBlksAnovaFrm.BrownForsytheOneWay(AReport: TStrings); +var + i: integer; + c1: array[1..50] of double; + cellmeans: array[1..50] of double; + sumc1: double; + fdegfree: double; + Fnumerator, Fdenominator, NewF: double; +begin + for i := 1 to 50 do + begin + c1[i] := 0.0; + cellmeans[i] := 0.0; + end; + + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]))); + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepVarCol,i])); + intvalue := intvalue - minf1 + 1; + cellcnts[intvalue-1] := 0.0; + cellsums[intvalue-1] := 0.0; + cellvars[intvalue-1] := 0.0; + end; + + MeanDep := 0.0; + SSDep := 0.0; + SSF1 := 0.0; + MSErr := 0.0; + N := 0; + + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]))); + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepVarCol,i])); + intvalue := intvalue - minf1 + 1; + cellcnts[intvalue-1] := cellcnts[intvalue-1] + 1; + cellsums[intvalue-1] := cellsums[intvalue-1] + X; + cellvars[intvalue-1] := cellvars[intvalue-1] + (X * X); + MeanDep := MeanDep + X; + SSDep := SSDep + X * X; + N := N + 1; + end; + + DFF1 := 0; + for i := 0 to Nf1cells-1 do + begin + if cellcnts[i] > 0 then + begin + cellvars[i] := cellvars[i] - (cellsums[i] * cellsums[i] /cellcnts[i]); + cellvars[i] := cellvars[i] / (cellcnts[i] - 1.0); + SSF1 := SSF1 + (sqr(cellsums[i]) / cellcnts[i]); + DFF1 := DFF1 + 1; + end; + end; + + SSF1 := SSF1 - (sqr(MeanDep) / N); + SSDep := SSDep - (sqr(MeanDep) / N); + SSErr := SSDep - SSF1; + DFTot := N - 1; + DFF1 := DFF1 - 1; + DFErr := DFTot - DFF1; + MSF1 := SSF1 / DFF1; + MSErr := SSErr / DFErr; + MSDep := SSDep / DFTot; + Omega := (SSF1 - DFF1 * MSErr) / (SSDep + MSErr); + F := MSF1 / MSErr; + ProbF1 := probf(F,DFF1,DFErr); + MeanDep := MeanDep / N; + + AReport.Add('BROWN-FORSYTHE ONE WAY ANALYSIS OF VARIANCE RESULTS'); + AReport.Add(''); + AReport.Add('Dependent variable is: %s, Independent variable is: %s', [DepVar.Text, Factor1.Text]); + AReport.Add(''); + AReport.Add('Traditional One-Way ANOVA Results'); + AReport.Add('---------------------------------------------------------------------'); + AReport.Add('SOURCE D.F. SS MS F PROB.>F OMEGA SQR.'); + AReport.Add('---------------------------------------------------------------------'); + AReport.Add('BETWEEN %4.0f%10.2f%10.2f%10.2f%10.2f%10.2f', [DFF1, SSF1, MSF1, F, ProbF1, Omega]); + AReport.Add('WITHIN %4.0f%10.2f%10.2f', [DFErr, SSErr, MSErr]); + AReport.Add('TOTAL %4.0f%10.2f', [DFTot, SSDep]); + AReport.Add('---------------------------------------------------------------------'); + + sumc1 := 0.0; + MSErr := 0.0; + for i := 0 to Nf1cells-1 do + begin +// MSErr := MSErr + (((1.0 - cellcnts[i] / N) * cellvars[i])); + c1[i+1] := (1.0 - (cellcnts[i] / N)) * cellvars[i]; + sumc1 := sumc1 + c1[i+1]; + end; +// MSErr := MSErr / DFF1; + for i := 1 to Nf1cells do + c1[i] := c1[i] / sumc1; + + fdegfree := 0.0; + for i := 1 to Nf1cells do + fdegfree := fdegfree + ((c1[i] * c1[i]) / (cellcnts[i-1]-1.0)); + fdegfree := round(1.0 / fdegfree); + + Fnumerator := 0.0; + Fdenominator := 0.0; + for i := 1 to Nf1cells do + begin + cellmeans[i] := cellsums[i-1] / cellcnts[i-1]; + Fnumerator := Fnumerator + (cellcnts[i-1] * (sqr(cellmeans[i] - MeanDep))); + Fdenominator := Fdenominator + ((1.0 - (cellcnts[i-1] / N)) * cellvars[i-1]); + end; + NewF := Fnumerator / Fdenominator; + ProbF1 := probf(NewF,DFF1, fdegfree); + + AReport.Add(''); + AReport.Add('---------------------------------------------------------------------'); + AReport.Add('Brown-Forsythe F statistic = %.3f', [NewF]); + AReport.Add('Brown-Forsythe denominator degrees of freedom = %.0f', [fdegfree]); + AReport.Add('Brown-Forsythe F probability = %.3f', [probf1]); + AReport.Add('---------------------------------------------------------------------'); + + { + if Outputfrm = nil then + OutputFrm := TOutputFrm.Create(Application) + else + OutputFrm.Clear; + OutputFrm.AddLines(AReport); + OutputFrm.ShowModal; + } + + WelchtTests(AReport); +end; + +procedure TBlksAnovaFrm.WelchOneWay(AReport: TStrings); +var + i: integer; + W, v, barx, numerator, denominator: double; + wj: array[1..50] of double; + c1: array[1..50] of double; + barxj: array[1..50] of double; + sumc1: double; + fdegfree, term1, term2, term3: double; +begin + for i := 1 to 50 do + begin + wj[i] := 0.0; + c1[i] := 0.0; + barxj[i] := 0.0; + end; + + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]))); + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepVarCol,i])); + intvalue := intvalue - minf1 + 1; + cellcnts[intvalue-1] := 0.0; + cellsums[intvalue-1] := 0.0; + cellvars[intvalue-1] := 0.0; + end; + + MeanDep := 0.0; + SSDep := 0.0; + SSF1 := 0.0; + MSErr := 0.0; + N := 0; + + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]))); + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepVarCol,i])); + intvalue := intvalue - minf1 + 1; + cellcnts[intvalue-1] := cellcnts[intvalue-1] + 1; + cellsums[intvalue-1] := cellsums[intvalue-1] + X; + cellvars[intvalue-1] := cellvars[intvalue-1] + (X * X); + MeanDep := MeanDep + X; + SSDep := SSDep + (X * X); + barxj[intvalue] := barxj[intvalue] + X; + N := N + 1; + end; + + DFF1 := 0; + W := 0.0; + barx := 0.0; + v := 0.0; + + for i := 0 to Nf1cells-1 do + begin + if cellcnts[i] > 0 then + begin + cellvars[i] := cellvars[i] - (cellsums[i] * cellsums[i] /cellcnts[i]); + cellvars[i] := cellvars[i] / (cellcnts[i] - 1.0); + wj[i+1] := cellcnts[i] / cellvars[i]; + W := W + wj[i+1]; + barxj[i+1] := barxj[i+1] / cellcnts[i]; + SSF1 := SSF1 + (sqr(cellsums[i]) / cellcnts[i]); + DFF1 := DFF1 + 1; + end; + end; + + for i := 1 to Nf1cells do + barx := barx + (wj[i] * barxj[i]); + barx := barx / W; + + numerator := 0.0; + for i := 1 to Nf1cells do + numerator := numerator + (wj[i]* sqr(barxj[i]-barx)); + numerator := numerator / (Nf1cells - 1.0); + + denominator := 0.0; + for i := 1 to Nf1cells do + v := v + ( (1.0 /(cellcnts[i-1]-1.0)) * (sqr(1.0 - wj[i]/W)) ); + v := 3.0 * v; + term1 := sqr(Nf1cells) - 1.0; + v := term1 / v; + for i := 1 to Nf1cells do + begin + term1 := 1.0 / (cellcnts[i-1] - 1.0); + term2 := sqr(1.0 - (wj[i] / W)); + denominator := denominator + (term1 * term2); + end; + term1 := sqr(Nf1cells) - 1.0; + term2 := 2.0 * (Nf1cells - 2.0); + term3 := 1.0; + denominator := term3 + ((term2 / term1) * denominator); + + F := numerator / denominator; + DFF1 := Nf1cells - 1; + SSF1 := SSF1 - (sqr(MeanDep) / float(N)); + SSDep := SSDep - (sqr(MeanDep) / float(N)); + SSErr := SSDep - SSF1; + DFTot := N - 1; + DFErr := DFTot - DFF1; + MSF1 := SSF1 / DFF1; + MeanDep := MeanDep / float(N); + + sumc1 := 0.0; + for i := 0 to Nf1cells-1 do + begin + MSErr := MSErr + (((1.0 - cellcnts[i] / N) * cellvars[i])/ DFF1); + c1[i+1] := (1.0 - (cellcnts[i] / N)) * cellvars[i]; + sumc1 := sumc1 + c1[i+1]; + end; + + for i := 1 to Nf1cells do + c1[i] := c1[i] / sumc1; + + fdegfree := 0.0; + for i := 1 to Nf1cells do + fdegfree := fdegfree + (c1[i] * c1[i]) / (cellcnts[i-1]-1.0); + fdegfree := round(1.0 / fdegfree); + + MSDep := SSDep / DFTot; + Omega := (SSF1 - DFF1 * MSErr) / (SSDep + MSErr); +// F := MSF1 / MSErr; +// ProbF1 := probf(F,DFF1, DFErr); + + AReport.Add('WELCH ONE WAY ANALYSIS OF VARIANCE RESULTS'); + AReport.Add(''); + AReport.Add('Dependent variable is: %s, Independent variable is: %s', [DepVar.Text, Factor1.Text]); + AReport.Add(''); +{ OutputFrm.RichEdit.Lines.Add('---------------------------------------------------------------------'); + OutputFrm.RichEdit.Lines.Add('SOURCE D.F. SS MS F PROB.>F OMEGA SQR.'); + OutputFrm.RichEdit.Lines.Add('---------------------------------------------------------------------'); + outline := format('BETWEEN %4.0f%10.2f%10.2f%10.2f%10.2f%10.2f', + [DFF1,SSF1,MSF1,F,ProbF1,Omega]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('WITHIN %4.0f%10.2f%10.2f',[DFErr,SSErr,MSErr]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('TOTAL %4.0f%10.2f',[DFTot,SSDep]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add('---------------------------------------------------------------------'); + OutputFrm.RichEdit.Lines.Add(''); } + AReport.Add('Welch F statistic = %8.4f', [F]); + AReport.Add('Welch denominator degrees of freedom = %3.0f', [v]); + + probF1 := probf(F,DFF1,v); + AReport.Add('Welch F probability = %5.3f', [probf1]); + + { + if OutputFrm = nil then + OutputFrm := TOutputFrm.Create(Application) + else + OutputFrm.Clear; + OutputFrm.AddLines(AReport); + OutputFrm.ShowModal; + } + + WelchtTests(AReport); +end; + +procedure TBlksAnovaFrm.WelchtTests(AReport: TStrings); +var + i, j, NoCompares: integer; + t: double; // Welch t value + gnu: double; // degrees of freedom + var1, var2: double; // variance estimates for two variables + mean1, mean2: double; // means for two variables + probability: double; // t probability + numerator, denominator, term1, term2: double; // work values + v: integer; // rounded degrees of freedom +begin + NoCompares := Nf1cells; + + AReport.Add(''); + AReport.Add('---------------------------------------------------------------------'); + AReport.Add('Welch t-tests among groups'); + AReport.Add('---------------------------------------------------------------------'); + + for i := 1 to NoCompares - 1 do + begin + for j := i + 1 to NoCompares do + begin + AReport.Add('Comparison of group %d with group %d', [i, j]); + mean1 := cellsums[i-1] / cellcnts[i-1]; + mean2 := cellsums[j-1] / cellcnts[j-1]; + var1 := cellvars[i-1]; + var2 := cellvars[j-1]; + denominator := sqrt((var1 / cellcnts[i-1]) + (var2 / cellcnts[j-1])); + numerator := mean1 - mean2; + t := numerator / denominator; + AReport.Add('Mean %d = %8.3f, Mean %d = %8.3f', [i, mean1, j, mean2]); + AReport.Add('Welch t = %8.3f' ,[t]); + + numerator := sqr((var1 /cellcnts[i-1]) + (var2 / cellcnts[j-1])); + term1 := sqr(var1) / (sqr(cellcnts[i-1]) * (cellcnts[i-1]-1.0)); + term2 := sqr(var2) / (sqr(cellcnts[j-1]) * (cellcnts[j-1]-1.0)); + denominator := term1 + term2; + numerator := sqr((var1 / cellcnts[i-1]) + (var2 / cellcnts[j-1])); + gnu := numerator / denominator; + AReport.Add('degrees of freedom = %8.3f', [gnu]); + + v := round(gnu); + AReport.Add('Rounded degrees of freedom = %d', [v]); + + probability := probt(t,gnu); + AReport.Add('Probability > t = %8.3f', [probability]); + AReport.Add(''); + end; + + AReport.Add(''); + end; + + { + if OutputFrm = nil then + OutputFrm := TOutputFrm.Create(Application) + else + OutputFrm.Clear; + OutputFrm.AddLines(AReport); + OutputFrm.ShowModal; + } +end; + +procedure TBlksAnovaFrm.UpdateBtnStates; +begin + DepIn.Enabled := VarList.ItemIndex > -1; + DepOut.Enabled := DepVar.Text <> ''; + + Fact1In.Enabled := VarList.ItemIndex > -1; + Fact1Out.Enabled := Factor1.Text <> ''; + + Fact2In.Enabled := VarList.ItemIndex > -1; + Fact2Out.Enabled := Factor2.Text <> ''; + + Fact3In.Enabled := VarList.ItemIndex > -1; + Fact3Out.Enabled := Factor3.Text <> ''; +end; + +procedure TBlksAnovaFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +function TBlksAnovaFrm.Validate(out AMsg: String; out AControl: TWinControl; + DepVarIndex, Fact1Index, Fact2Index, Fact3Index: Integer): Boolean; +var + a: Double; +begin + Result := false; + + if (DepVarIndex = 0) then + begin + if DepVar.Text <> '' then + begin + AMsg := 'Dependent variable not found.'; + AControl := DepVar; + end else + begin + AMsg := 'Dependent variable not specified.'; + AControl := VarList; + end; + exit; + end; + + if (Fact1Index = 0) then + begin + if Factor1.Text <> '' then + begin + AMsg := 'Factor 1 variable not found'; + AControl := Factor1; + end else + begin + Amsg := 'Factor 1 variable not specified.'; + AControl := VarList; + end; + exit; + end; + + if (Fact2Index = 0) and (Factor2.Text <> '') then + begin + AMsg := 'Factor 2 variable not found.'; + AControl := Factor2; + exit; + end; + + if (Fact3Index = 0) and (Factor3.Text <> '') then + begin + AMsg := 'Factor3 variable not found.'; + AControl := Factor3; + exit; + end; + + if OverallAlpha.Text = '' then + begin + AMsg := 'Overall alpha level not specified.'; + AControl := OverallAlpha; + exit; + end; + if not TryStrToFloat(OverallAlpha.Text, a) then + begin + AMsg := 'Overall alpha level is not a valid number.'; + AControl := OverallAlpha; + exit; + end; + + if PostAlpha.Text = '' then + begin + AMsg := 'Post-hoc alpha level not specified.'; + AControl := PostAlpha; + exit; + end; + if not TryStrToFloat(PostAlpha.Text, a) then + begin + AMsg := 'Post-hoc alpha level is not a valid number.'; + AControl := PostAlpha; + exit; + end; + + Result := true; +end; + + +initialization + {$I blkanovaunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/bnestaunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/bnestaunit.lfm new file mode 100644 index 000000000..e76858926 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/bnestaunit.lfm @@ -0,0 +1,370 @@ +object BNestedAForm: TBNestedAForm + Left = 768 + Height = 498 + Top = 238 + Width = 488 + AutoSize = True + Caption = 'Factor B Nested in Factor A Analysis of Variance' + ClientHeight = 498 + ClientWidth = 488 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 114 + Width = 100 + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + Caption = 'Available Variables:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = ACodes + Left = 266 + Height = 15 + Top = 138 + Width = 88 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor A Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = BInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = BCodes + Left = 266 + Height = 15 + Top = 222 + Width = 115 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor B (Nested in A)' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = DepEdit + Left = 266 + Height = 15 + Top = 317 + Width = 102 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AInBtn + AnchorSideBottom.Control = OptionsBox + Left = 9 + Height = 239 + Top = 130 + Width = 213 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 9 + BorderSpacing.Top = 1 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object AInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 230 + Height = 28 + Top = 130 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = AInBtnClick + Spacing = 0 + TabOrder = 1 + end + object AOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = AInBtn + AnchorSideTop.Side = asrBottom + Left = 230 + Height = 28 + Top = 162 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = AOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object BInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = AOutBtn + AnchorSideTop.Side = asrBottom + Left = 230 + Height = 28 + Top = 214 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = BInBtnClick + Spacing = 0 + TabOrder = 4 + end + object BOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = BInBtn + AnchorSideTop.Side = asrBottom + Left = 230 + Height = 28 + Top = 246 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = BOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object DepInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = RandomBChk + AnchorSideTop.Side = asrBottom + Left = 230 + Height = 28 + Top = 309 + Width = 28 + BorderSpacing.Top = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInBtnClick + Spacing = 0 + TabOrder = 8 + end + object DepOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepInBtn + AnchorSideTop.Side = asrBottom + Left = 230 + Height = 28 + Top = 341 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutBtnClick + Spacing = 0 + TabOrder = 9 + end + object ACodes: TEdit + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = AOutBtn + AnchorSideBottom.Side = asrBottom + Left = 266 + Height = 23 + Top = 155 + Width = 214 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'ACodes' + end + object BCodes: TEdit + AnchorSideLeft.Control = BInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = BOutBtn + AnchorSideBottom.Side = asrBottom + Left = 266 + Height = 23 + Top = 239 + Width = 214 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'BCodes' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 275 + Height = 25 + Top = 465 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 12 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 337 + Height = 25 + Top = 465 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 13 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 421 + Height = 25 + Top = 465 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 14 + end + object DepEdit: TEdit + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOutBtn + AnchorSideBottom.Side = asrBottom + Left = 266 + Height = 23 + Top = 334 + Width = 214 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 10 + Text = 'DepEdit' + end + object OptionsBox: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 72 + Top = 377 + Width = 466 + Anchors = [akLeft, akBottom] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'OptionsBox' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 16 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 52 + ClientWidth = 462 + Columns = 2 + Items.Strings = ( + 'Plot means using 2D Horizontal Bars' + 'Plot means using 3D Horizontal Bars' + 'Plot means using 2D Vertical Bars' + 'Plot means using 3D Vertical Bars' + ) + TabOrder = 11 + end + object RandomBChk: TCheckBox + AnchorSideLeft.Control = BCodes + AnchorSideTop.Control = BOutBtn + AnchorSideTop.Side = asrBottom + Left = 266 + Height = 19 + Top = 282 + Width = 136 + BorderSpacing.Top = 8 + Caption = 'B is random, not fixed' + TabOrder = 7 + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 90 + Top = 8 + Width = 472 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Directions: This analysis assumes that levels of Factor B are Nested within levels of Factor A. Unless otherwise specified, it is assumed that Factors A and B are fixed level factors. If Factor B is a random variable, check the provided box to indicate this.'#13#10#13#10'The number of cases for each B group should be equal and the number of B treatements in each A level should be equal.' + ParentColor = False + WordWrap = True + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 449 + Width = 488 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/bnestaunit.pas b/applications/lazstats/source/forms/analysis/comparisons/bnestaunit.pas new file mode 100644 index 000000000..cf0ab6362 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/bnestaunit.pas @@ -0,0 +1,601 @@ +unit BNestAUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, GraphLib, Globals; + +type + + { TBNestedAForm } + + TBNestedAForm = class(TForm) + ACodes: TEdit; + AInBtn: TBitBtn; + AOutBtn: TBitBtn; + BCodes: TEdit; + Bevel1: TBevel; + BInBtn: TBitBtn; + BOutBtn: TBitBtn; + Memo1: TLabel; + RandomBChk: TCheckBox; + DepInBtn: TBitBtn; + ComputeBtn: TButton; + DepOutBtn: TBitBtn; + DepEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + OptionsBox: TRadioGroup; + ResetBtn: TButton; + CloseBtn: TButton; + VarList: TListBox; + procedure AInBtnClick(Sender: TObject); + procedure AOutBtnClick(Sender: TObject); + procedure BInBtnClick(Sender: TObject); + procedure BOutBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure DepInBtnClick(Sender: TObject); + procedure DepOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + SS, SumSqr, CellMeans, CellSDs : DblDyneMat; + CellCount : IntDyneMat; + ASS, BSS, ASumSqr, BSumSqr, AMeans, BMeans, ASDs : DblDyneVec; + ACount, BCount : IntDyneVec; + MinA, MinB, MaxA, MaxB, NoALevels, NoBLevels, ACol, BCol, YCol : integer; + DepVar, FactorA, FactorB : string; + SSTot, SumSqrTot, TotMean, MSTot, SSA, MSA, SSB, MSB, SSW, MSW : double; + TotN, dfA, dfBwA, dfwcell, dftotal : integer; + + function GetVars: Boolean; + procedure GetMemory; + procedure GetSums; + procedure ShowMeans(AReport: TStrings); + procedure GetResults; + procedure ShowResults(AReport: TStrings); + procedure ReleaseMemory; + procedure TwoWayPlot; + + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + BNestedAForm: TBNestedAForm; + +implementation + +uses + Math; + +{ TBNestedAForm } + +procedure TBNestedAForm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Items.Clear; + ACodes.Text := ''; + BCodes.Text := ''; + DepEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TBNestedAForm.AInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (ACodes.Text = '') then + begin + ACodes.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TBNestedAForm.AOutBtnClick(Sender: TObject); +begin + if ACodes.Text <> '' then + begin + VarList.Items.Add(ACodes.Text); + ACodes.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TBNestedAForm.BInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (BCodes.Text = '') then + begin + BCodes.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TBNestedAForm.BOutBtnClick(Sender: TObject); +begin + if BCodes.Text <> '' then + begin + VarList.Items.Add(BCodes.Text); + BCodes.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TBNestedAForm.ComputeBtnClick(Sender: TObject); +var + lReport: TStrings; +begin + lReport := TStringList.Create; + try + if GetVars then + begin + GetMemory; + GetSums; + ShowMeans(lReport); + GetResults; + ShowResults(lReport); + DisplayReport(lReport); + TwoWayPlot; + ReleaseMemory; + end; + finally + lReport.Free; + end; +end; + +procedure TBNestedAForm.DepInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepEdit.Text = '') then + begin + DepEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TBNestedAForm.DepOutBtnClick(Sender: TObject); +begin + if DepEdit.Text <> '' then + begin + VarList.Items.Add(DepEdit.Text); + DepEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TBNestedAForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinHeight := DepOutBtn.Top + DepOutBtn.Height - VarList.Top; + Constraints.MinHeight := Height; + Constraints.MinWidth := Width; + + FAutoSized := true; +end; + +procedure TBNestedAForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +function TBNestedAForm.GetVars: Boolean; +var + i, group : integer; + strvalue, cellstring : string; +begin + Result := false; + DepVar := DepEdit.Text; + FactorA := ACodes.Text; + FactorB := BCodes.Text; + ACol := 0; + BCol := 0; + YCol := 0; + MinA := 1000; + MaxA := -1000; + MinB := 1000; + MaxB := -1000; + for i := 1 to NoVariables do + begin + strvalue := Trim(OS3MainFrm.DataGrid.Cells[i,0]); + if FactorA = strvalue then ACol := i; + if FactorB = strvalue then BCol := i; + if DepVar = strvalue then YCol := i; + end; + if (ACol = 0) or (BCol = 0) or (YCol = 0) then + begin + MessageDlg('Select a variable for each entry box.', mtError, [mbOK], 0); + exit; + end; + // get number of levels for Factors + for i := 1 to NoCases do + begin + cellstring := Trim(OS3MainFrm.DataGrid.Cells[ACol,i]); + group := round(StrToFloat(cellstring)); + if (group > MaxA) then MaxA := group; + if (group < MinA) then MinA := group; + cellstring := Trim(OS3MainFrm.DataGrid.Cells[BCol,i]); + group := round(StrToFLoat(cellstring)); + if (group > MaxB) then MaxB := group; + if (group < MinB) then MinB := group; + end; + NoALevels := MaxA - MinA + 1; + NoBLevels := MaxB - MinB + 1; + + Result := true; +end; + +procedure TBNestedAForm.GetMemory; +begin + SetLength(SS,NoBLevels,NoALevels); + SetLength(SumSqr,NoBLevels,NoALevels); + SetLength(CellCount,NoBLevels,NoALevels); + SetLength(CellMeans,NoBLevels,NoALevels); + SetLength(CellSDs,NoBLevels,NoALevels); + SetLength(ASS,NoALevels); + SetLength(BSS,NoBLevels); + SetLength(ASumSqr,NoALevels); + SetLength(BSumSqr,NoBLevels); + SetLength(AMeans,NoALevels); + SetLength(BMeans,NoBLevels); + SetLength(ACount,NoALevels); + SetLength(BCount,NoBLevels); + SetLength(ASDs,NoALevels); +end; + +procedure TBNestedAForm.GetSums; +VAR + Aindex, Bindex, i, j : integer; + YValue : double; + strvalue : string; +begin + // initialize memory + for i := 0 to NoBLevels-1 do + begin + for j := 0 to NoALevels-1 do + begin + SS[i,j] := 0.0; + SumSqr[i,j] := 0.0; + CellCount[i,j] := 0; + end; + end; + for i := 0 to NoALevels-1 do + begin + ACount[i] := 0; + AMeans[i] := 0.0; + ASS[i] := 0.0; + ASumSqr[i] := 0.0; + end; + for j := 0 to NoBLevels-1 do + begin + BCount[i] := 0; + BMeans[i] := 0.0; + BSS[i] := 0.0; + BSumSqr[i] := 0.0; + end; + // Accumulate sums and sums of squared values + for i := 1 to NoCases do + begin + strvalue := Trim(OS3MainFrm.DataGrid.Cells[ACol,i]); + Aindex := round(StrToFloat(strvalue)); + strvalue := Trim(OS3MainFrm.DataGrid.Cells[BCol,i]); + Bindex := round(StrToFloat(strvalue)); + strvalue := Trim(OS3MainFrm.DataGrid.Cells[YCol,i]); + YValue := StrToFloat(strvalue); + Aindex := Aindex - MinA; + Bindex := Bindex - MinB; + SS[Bindex,Aindex] := SS[Bindex,Aindex] + YValue * YValue; + SumSqr[Bindex,Aindex] := SumSqr[Bindex,Aindex] + YValue; + CellCount[Bindex,Aindex] := CellCount[Bindex,Aindex] + 1; + ACount[Aindex] := ACount[Aindex] + 1; + BCount[Bindex] := BCount[Bindex] + 1; + ASS[Aindex] := ASS[Aindex] + YValue * YValue; + BSS[Bindex] := BSS[Bindex] + YValue * YValue; + ASumSqr[Aindex] := ASumSqr[Aindex] + YValue; + BSumSqr[Bindex] := BSumSqr[Bindex] + YValue; + SSTot := SSTot + YValue * YValue; + SumSqrTot := SumSqrTot + YValue; + TotN := TotN + 1; + end; + //get cell means and marginal means, SDs plus square of sums + for i := 0 to NoBlevels-1 do + begin + for j := 0 to NoALevels-1 do + begin + if CellCount[i,j] > 0 then + begin + CellMeans[i,j] := SumSqr[i,j] / CellCount[i,j]; + SumSqr[i,j] := SumSqr[i,j] * SumSqr[i,j]; + CellSDs[i,j] := SS[i,j] - (SumSqr[i,j] / CellCount[i,j]); + CellSDs[i,j] := CellSDs[i,j] / (CellCount[i,j] - 1); + CellSDs[i,j] := Sqrt(CellSDs[i,j]); + end; + end; + end; + for i := 0 to NoBLevels-1 do + begin + BMeans[i] := BSumSqr[i] / BCount[i]; + BSumSqr[i] := BSumSqr[i] * BSumSqr[i]; + end; + for i := 0 to NoALevels-1 do + begin + AMeans[i] := ASumSqr[i] / ACount[i]; + ASumSqr[i] := ASumSqr[i] * ASumSqr[i]; + ASDs[i] := ASS[i] - (ASumSqr[i] / ACount[i]); + ASDs[i] := ASDs[i] / (ACount[i] - 1); + ASDs[i] := Sqrt(ASDs[i]); + end; + TotMean := SumSqrTot / TotN; + SumSqrTot := SumSqrTot * SumSqrTot; +end; + +procedure TBNestedAForm.ShowMeans(AReport: TStrings); +var + i, j: integer; +begin + AReport.Add('NESTED ANOVA by Bill Miller'); + AReport.Add(''); + AReport.Add('File Analyzed: %s', [OS3MainFrm.FileNameEdit.Text]); + AReport.Add(''); + AReport.Add('CELL MEANS'); + AReport.Add('A LEVEL BLEVEL MEAN STD.DEV.'); + for i := 0 to NoALevels-1 do + for j := 0 to NoBLevels-1 do + if CellCount[j,i] > 0 then + AReport.Add('%5d %5d %10.3f %10.3f', [i+MinA, j+MinB, CellMeans[j,i], CellSDs[j,i]]); + AReport.Add(''); + AReport.Add('A MARGIN MEANS'); + AReport.Add('A LEVEL MEAN STD.DEV.'); + for i := 0 to NoALevels-1 do + AReport.Add('%5d %10.3f %10.3f', [i+MinA, AMeans[i], ASDs[i]]); + AReport.Add(''); + AReport.Add('GRAND MEAN: %0.3f', [TotMean]); + AReport.Add(''); + AReport.Add(''); +end; + +procedure TBNestedAForm.GetResults; +VAR + temp, constant : double; + NoBLevelsInA, BLevCount, i, j, celln : integer; +begin + celln := 0; + for i := 0 to NoALevels-1 do + begin + for j := 0 to NoBLevels-1 do + begin + if CellCount[j,i] > celln then celln := CellCount[j,i]; + end; + end; + // assume all cells have same n size + // get no. of levels in A + BLevCount := 0; + for i := 0 to NoALevels-1 do + begin + NoBLevelsInA := 0; + for j := 0 to NoBLevels-1 do + begin + if CellCount[j,i] > 0 then NoBLevelsInA := NoBLevelsInA + 1; + end; + if NoBLevelsInA > BLevCount then BLevCount := NoBLevelsInA; + end; + dfA := NoALevels - 1; + dfBwA := NoALevels * (BLevCount - 1); + dfwcell := NoALevels * BLevCount * (celln - 1); + dftotal := TotN - 1; + constant := SumSqrTot / TotN; + SSTot := SSTot - constant; + MSTot := SSTot / dftotal; + SSA := 0.0; + for i := 0 to NoALevels-1 do SSA := SSA + (ASumSqr[i] / ACount[i]); + temp := SSA; + SSA := SSA - constant; + MSA := SSA / dfA; + SSB := 0.0; + for i := 0 to NoALevels - 1 do + begin + for j := 0 to NoBLevels-1 do + begin + if CellCount[j,i] > 0 then SSB := SSB + (SumSqr[j,i] / CellCount[j,i]); + end; + end; + SSB := SSB - temp; + MSB := SSB / dfBwA; + SSW := SSTot - SSA - SSB; + MSW := SSW / dfwcell; + (* + OutputFrm.RichEdit.Clear; + strvalue := format('SSA = %10.3f MSA = %10.3f SSB = %10.3f MSB = %10.3f', + [SSA,MSA,SSB,MSB]); + OutputFrm.RichEdit.Lines.Add(strvalue); + strvalue := format('SSW = %10.3f MSW = %10.3f',[SSW,MSW]); + OutputFrm.RichEdit.Lines.Add(strvalue); + OutputFrm.ShowModal; +*) +end; + +procedure TBNestedAForm.ShowResults(AReport: TStrings); +var + F, PF: double; +begin + AReport.Add('ANOVA TABLE'); + AReport.Add('SOURCE D.F. SS MS F PROB.'); + + if RandomBChk.Checked then + begin + F := MSA / MSB; + PF := probf(F, dfA, dfBwA); + end else + begin + F := MSA / MSW; + PF := probf(F, dfA, dfwcell); + end; + AReport.Add('A %4d %10.3f%10.3f%10.3f%10.3f', [dfA, SSA, MSA, F, PF]); + + F := MSB / MSW; + PF := probf(F,dfBwA,dfwcell); + AReport.Add('B(W) %4d %10.3f%10.3f%10.3f%10.3f', [dfBwA, SSB, MSB, F, PF]); + + AReport.Add('w.cells %4d %10.3f%10.3f', [dfwcell, SSW, MSW]); + AReport.Add('Total %4d %10.3f', [dftotal, SSTot]); +end; + +procedure TBNestedAForm.ReleaseMemory; +begin + ASDs := nil; + BCount := nil; + ACount := nil; + BMeans := nil; + AMeans := nil; + BSumSqr := nil; + ASumSqr := nil; + BSS := nil; + ASS := nil; + CellSDs := nil; + CellMeans := nil; + CellCount := nil; + SumSqr := nil; + SS := nil; +end; + +procedure TBNestedAForm.TwoWayPlot; +VAR + plottype, i: integer; + maxmean: double; + title: string; + XValue : DblDyneVec; +begin + case OptionsBox.ItemIndex of + 0: plotType := 9; + 1: plotType := 10; + 2: plotType := 1; + 3: plotType := 2; + else raise Exception.Create('Plot type not supported.'); + end; + + GraphFrm.SetLabels[1] := 'FACTOR A'; + + maxmean := -1000.0; + SetLength(XValue,NoALevels+NoBLevels); + SetLength(GraphFrm.Xpoints,1,NoALevels); + SetLength(GraphFrm.Ypoints,1,NoALevels); + for i := 1 to NoALevels do + begin + GraphFrm.Ypoints[0,i-1] := AMeans[i-1]; + if AMeans[i-1] > maxmean then maxmean := AMeans[i-1]; + XValue[i-1] := MinA + i -1; + GraphFrm.Xpoints[0,i-1] := XValue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NoALevels; + GraphFrm.Heading := FactorA; + GraphFrm.XTitle := FactorA + ' Group Codes'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + + // Factor B next + maxmean := 0.0; + GraphFrm.SetLabels[1] := 'FACTOR B'; + SetLength(GraphFrm.Xpoints,1,NoBLevels); + SetLength(GraphFrm.Ypoints,1,NoBLevels); + for i := 1 to NoBLevels do + begin + GraphFrm.Ypoints[0,i-1] := BMeans[i-1]; + if BMeans[i-1] > maxmean then maxmean := BMeans[i-1]; + XValue[i-1] := MinB + i - 1; + GraphFrm.Xpoints[0,i-1] := XValue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NoBLevels; + GraphFrm.Heading := 'FACTOR B'; + GraphFrm.XTitle := FactorB + ' Group Codes'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + XValue := nil; +end; + +procedure TBNestedAForm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TBNestedAForm.UpdateBtnStates; +var + i: Integer; + lSelected: Boolean; +begin + lSelected := false; + for i := 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + + AInBtn.Enabled := lSelected and (ACodes.Text = ''); + BInBtn.Enabled := lSelected and (BCodes.Text = ''); + DepInBtn.Enabled := lSelected and (DepEdit.Text = ''); + AOutBtn.Enabled := (ACodes.Text <> ''); + BOutBtn.Enabled := (BCodes.Text <> ''); + DepOutBtn.Enabled := (DepEdit.Text <> ''); +end; + +initialization + {$I bnestaunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/glmunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/glmunit.lfm new file mode 100644 index 000000000..dd6a980cf --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/glmunit.lfm @@ -0,0 +1,1130 @@ +object GLMFrm: TGLMFrm + Left = 486 + Height = 566 + Top = 156 + Width = 862 + Caption = 'General Linear Model' + ClientHeight = 566 + ClientWidth = 862 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 561 + Height = 25 + Top = 533 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 627 + Height = 25 + Top = 533 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 4 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 701 + Height = 25 + Top = 533 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 789 + Height = 25 + Top = 533 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 6 + end + object HelpBtn: TButton + Tag = 126 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 498 + Height = 25 + Top = 533 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 2 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 517 + Width = 862 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Memo2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 30 + Top = 8 + Width = 846 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'NOTE! Be sure to enter the dependent variable(s) first, then the independent variables. When defining interactions, enter two-way interactions first, then three-way, etc.' + ParentColor = False + WordWrap = True + end + object Panel11: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Memo2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel14 + Left = 0 + Height = 337 + Top = 38 + Width = 862 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Bottom = 12 + BevelOuter = bvNone + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsHomogenousChildResize + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 4 + ClientHeight = 337 + ClientWidth = 862 + TabOrder = 0 + object Panel9: TPanel + Left = 0 + Height = 329 + Top = 8 + Width = 236 + BevelOuter = bvNone + ChildSizing.VerticalSpacing = 8 + ChildSizing.EnlargeHorizontal = crsScaleChilds + ChildSizing.EnlargeVertical = crsScaleChilds + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 329 + ClientWidth = 236 + TabOrder = 0 + OnResize = Panel9Resize + object Panel6: TPanel + Left = 0 + Height = 76 + Top = 0 + Width = 236 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 76 + ClientWidth = 236 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel6 + AnchorSideTop.Control = Panel6 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 15 + Top = 0 + Width = 28 + BorderSpacing.Left = 8 + Caption = 'Code' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = DepContList + AnchorSideTop.Control = Panel6 + AnchorSideBottom.Side = asrBottom + Left = 59 + Height = 15 + Top = 0 + Width = 116 + Caption = 'Continuous Dep. Vars.' + ParentColor = False + end + object DepContList: TListBox + AnchorSideLeft.Control = ContDepCode + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ContDepInBtn + AnchorSideBottom.Control = Panel6 + AnchorSideBottom.Side = asrBottom + Left = 59 + Height = 59 + Top = 17 + Width = 133 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 1 + end + object ContDepCode: TListBox + AnchorSideLeft.Control = Panel6 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = Panel6 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 59 + Top = 17 + Width = 43 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + TabOrder = 0 + end + object ContDepInBtn: TBitBtn + AnchorSideTop.Control = ContDepCode + AnchorSideRight.Control = Panel6 + AnchorSideRight.Side = asrBottom + Left = 200 + Height = 28 + Top = 17 + Width = 28 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ContDepInBtnClick + Spacing = 0 + TabOrder = 2 + end + object ContDepOutBtn: TBitBtn + AnchorSideTop.Control = ContDepInBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel6 + AnchorSideRight.Side = asrBottom + Left = 200 + Height = 28 + Top = 49 + Width = 28 + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ContDepOutBtnClick + Spacing = 0 + TabOrder = 3 + end + end + object Panel7: TPanel + Left = 0 + Height = 76 + Top = 84 + Width = 236 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 76 + ClientWidth = 236 + TabOrder = 1 + object Label6: TLabel + AnchorSideLeft.Control = DepCatList + AnchorSideTop.Control = Panel7 + Left = 60 + Height = 15 + Top = 0 + Width = 114 + Caption = 'Categorical Dep. Vars.' + ParentColor = False + end + object CatDepInBtn: TBitBtn + AnchorSideTop.Control = DepCatList + AnchorSideRight.Control = Panel7 + AnchorSideRight.Side = asrBottom + Left = 200 + Height = 28 + Top = 17 + Width = 28 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = CatDepInBtnClick + Spacing = 0 + TabOrder = 2 + end + object CatDepOutBtn: TBitBtn + AnchorSideTop.Control = CatDepInBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel7 + AnchorSideRight.Side = asrBottom + Left = 200 + Height = 28 + Top = 49 + Width = 28 + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = CatDepOutBtnClick + Spacing = 0 + TabOrder = 3 + end + object DepCatList: TListBox + AnchorSideLeft.Control = CatDepCode + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label6 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CatDepInBtn + AnchorSideBottom.Control = Panel7 + AnchorSideBottom.Side = asrBottom + Left = 60 + Height = 59 + Top = 17 + Width = 132 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 1 + end + object CatDepCode: TListBox + AnchorSideLeft.Control = Panel7 + AnchorSideTop.Control = DepCatList + AnchorSideBottom.Control = Panel7 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 59 + Top = 17 + Width = 44 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Left = 8 + ItemHeight = 0 + TabOrder = 0 + end + end + object Panel8: TPanel + Left = 0 + Height = 77 + Top = 168 + Width = 236 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 77 + ClientWidth = 236 + TabOrder = 2 + object Label7: TLabel + AnchorSideLeft.Control = RepeatList + AnchorSideTop.Control = Panel8 + Left = 60 + Height = 15 + Top = 0 + Width = 137 + Caption = 'Repeated Meas. Dep. Vars.' + ParentColor = False + end + object RepDepInBtn: TBitBtn + AnchorSideTop.Control = RepeatList + AnchorSideRight.Control = Panel8 + AnchorSideRight.Side = asrBottom + Left = 200 + Height = 28 + Top = 17 + Width = 28 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = RepDepInBtnClick + Spacing = 0 + TabOrder = 2 + end + object ReptDepOutBtn: TBitBtn + AnchorSideTop.Control = RepDepInBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel8 + AnchorSideRight.Side = asrBottom + Left = 200 + Height = 28 + Top = 49 + Width = 28 + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ReptDepOutBtnClick + Spacing = 0 + TabOrder = 3 + end + object RepeatList: TListBox + AnchorSideLeft.Control = ReptDepCode + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label7 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = RepDepInBtn + AnchorSideBottom.Control = Panel8 + AnchorSideBottom.Side = asrBottom + Left = 60 + Height = 60 + Top = 17 + Width = 132 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 1 + end + object ReptDepCode: TListBox + AnchorSideLeft.Control = Panel8 + AnchorSideTop.Control = RepeatList + AnchorSideBottom.Control = Panel8 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 60 + Top = 17 + Width = 44 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Left = 8 + ItemHeight = 0 + TabOrder = 0 + end + end + object Bevel3: TBevel + Left = 0 + Height = 76 + Top = 253 + Width = 236 + Constraints.MinHeight = 76 + Shape = bsSpacer + end + end + object Panel10: TPanel + Left = 236 + Height = 329 + Top = 8 + Width = 132 + BevelOuter = bvNone + ClientHeight = 329 + ClientWidth = 132 + TabOrder = 1 + object Label3: TLabel + AnchorSideLeft.Control = Panel10 + AnchorSideTop.Control = Panel10 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Available Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel10 + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel10 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel10 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 312 + Top = 17 + Width = 132 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + end + object Panel5: TPanel + Left = 368 + Height = 329 + Top = 8 + Width = 234 + AutoSize = True + BevelOuter = bvNone + ChildSizing.VerticalSpacing = 8 + ChildSizing.EnlargeHorizontal = crsScaleChilds + ChildSizing.EnlargeVertical = crsScaleChilds + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 329 + ClientWidth = 234 + TabOrder = 2 + object Panel1: TPanel + Left = 0 + Height = 76 + Top = 0 + Width = 234 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 76 + ClientWidth = 234 + TabOrder = 0 + object Label4: TLabel + AnchorSideLeft.Control = FixedList + AnchorSideTop.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 44 + Height = 15 + Top = 0 + Width = 124 + Caption = 'Fixed Effect Indep. Vars.' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = FixedIndepCode + AnchorSideTop.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 184 + Height = 15 + Top = 0 + Width = 28 + Caption = 'Code' + ParentColor = False + end + object FixedList: TListBox + AnchorSideLeft.Control = FixedIndepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = FixedIndepCode + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 44 + Height = 59 + Top = 17 + Width = 132 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnClick = FixedListClick + TabOrder = 2 + end + object FixedIndepCode: TListBox + AnchorSideTop.Control = FixedList + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 184 + Height = 59 + Top = 17 + Width = 50 + Anchors = [akTop, akRight, akBottom] + ItemHeight = 0 + TabOrder = 3 + end + object FixedIndepInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = FixedList + Left = 8 + Height = 28 + Top = 17 + Width = 28 + BorderSpacing.Left = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = FixedIndepInBtnClick + Spacing = 0 + TabOrder = 0 + end + object FixedIndepOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = FixedIndepInBtn + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = FixedIndepOutBtnClick + Spacing = 0 + TabOrder = 1 + end + end + object Panel2: TPanel + Left = 0 + Height = 76 + Top = 84 + Width = 234 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 76 + ClientWidth = 234 + TabOrder = 1 + object Label8: TLabel + AnchorSideLeft.Control = RandomList + AnchorSideTop.Control = Panel2 + Left = 44 + Height = 15 + Top = 0 + Width = 141 + Caption = 'Random Effect Indep. Vars.' + ParentColor = False + end + object RandomList: TListBox + AnchorSideLeft.Control = RndIndepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label8 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = RndIndepCode + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 44 + Height = 59 + Top = 17 + Width = 132 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnClick = RandomListClick + TabOrder = 2 + end + object RndIndepCode: TListBox + AnchorSideTop.Control = RandomList + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 184 + Height = 59 + Top = 17 + Width = 50 + Anchors = [akTop, akRight, akBottom] + ItemHeight = 0 + TabOrder = 3 + end + object RndIndepInBtn: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = RandomList + Left = 8 + Height = 28 + Top = 17 + Width = 28 + BorderSpacing.Left = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = RndIndepInBtnClick + Spacing = 0 + TabOrder = 0 + end + object RndIndepOutBtn: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = RndIndepInBtn + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = RndIndepOutBtnClick + Spacing = 0 + TabOrder = 1 + end + end + object Panel3: TPanel + Left = 0 + Height = 76 + Top = 168 + Width = 234 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 76 + ClientWidth = 234 + TabOrder = 2 + object Label9: TLabel + AnchorSideLeft.Control = CovariateList + AnchorSideTop.Control = Panel3 + Left = 44 + Height = 15 + Top = 0 + Width = 128 + Caption = 'Covariates (Continuous)' + ParentColor = False + end + object CovariateList: TListBox + AnchorSideLeft.Control = CovInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label9 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CovariateCode + AnchorSideBottom.Control = Panel3 + AnchorSideBottom.Side = asrBottom + Left = 44 + Height = 59 + Top = 17 + Width = 132 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnClick = CovariateListClick + TabOrder = 2 + end + object CovariateCode: TListBox + AnchorSideTop.Control = CovariateList + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel3 + AnchorSideBottom.Side = asrBottom + Left = 184 + Height = 59 + Top = 17 + Width = 50 + Anchors = [akTop, akRight, akBottom] + ItemHeight = 0 + TabOrder = 3 + end + object CovInBtn: TBitBtn + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = CovariateList + Left = 8 + Height = 28 + Top = 17 + Width = 28 + BorderSpacing.Left = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = CovInBtnClick + Spacing = 0 + TabOrder = 0 + end + object CovOutBtn: TBitBtn + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = CovInBtn + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = CovOutBtnClick + Spacing = 0 + TabOrder = 1 + end + end + object Panel4: TPanel + Left = 0 + Height = 77 + Top = 252 + Width = 234 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 77 + ClientWidth = 234 + TabOrder = 3 + object Label10: TLabel + AnchorSideLeft.Control = RepTrtList + AnchorSideTop.Control = Panel4 + Left = 44 + Height = 15 + Top = 0 + Width = 121 + Caption = 'Repeated Meas. Effects' + ParentColor = False + end + object RepTrtList: TListBox + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label10 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = RepTrtCode + AnchorSideBottom.Control = Panel4 + AnchorSideBottom.Side = asrBottom + Left = 44 + Height = 60 + Top = 17 + Width = 132 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnClick = RepTrtListClick + TabOrder = 0 + end + object RepTrtCode: TListBox + AnchorSideTop.Control = RepTrtList + AnchorSideRight.Control = Panel4 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel4 + AnchorSideBottom.Side = asrBottom + Left = 184 + Height = 60 + Top = 17 + Width = 50 + Anchors = [akTop, akRight, akBottom] + ItemHeight = 0 + TabOrder = 1 + end + object Bevel2: TBevel + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = RepTrtList + AnchorSideBottom.Control = Panel4 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 23 + Top = 54 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + Shape = bsSpacer + end + end + end + object Panel12: TPanel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 602 + Height = 329 + Top = 8 + Width = 260 + AutoSize = True + BorderSpacing.Top = 8 + BevelOuter = bvNone + ClientHeight = 329 + ClientWidth = 260 + TabOrder = 3 + object StartInterBtn: TButton + AnchorSideLeft.Control = InterDefList + AnchorSideTop.Control = Panel12 + Left = 20 + Height = 25 + Top = 0 + Width = 201 + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Begin Definition of an Interaction' + OnClick = StartInterBtnClick + TabOrder = 0 + end + object InterDefList: TListBox + AnchorSideLeft.Control = Panel12 + AnchorSideTop.Control = StartInterBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel12 + AnchorSideRight.Side = asrBottom + Left = 20 + Height = 103 + Top = 27 + Width = 232 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 20 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 1 + end + object Label11: TLabel + AnchorSideLeft.Control = InterDefList + AnchorSideTop.Control = InterDefList + AnchorSideTop.Side = asrBottom + Left = 20 + Height = 15 + Top = 138 + Width = 141 + BorderSpacing.Top = 8 + Caption = 'List of Defined Interactions' + ParentColor = False + end + object EndDefBtn: TButton + AnchorSideLeft.Control = InterDefList + AnchorSideTop.Control = Label11 + AnchorSideTop.Side = asrBottom + Left = 20 + Height = 25 + Top = 161 + Width = 195 + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'End Definititon of an Interaction' + OnClick = EndDefBtnClick + TabOrder = 2 + end + object InteractList: TListBox + AnchorSideLeft.Control = InterDefList + AnchorSideTop.Control = EndDefBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel12 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel12 + AnchorSideBottom.Side = asrBottom + Left = 20 + Height = 135 + Top = 194 + Width = 232 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 3 + end + end + end + object Panel13: TPanel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 93 + Top = 424 + Width = 846 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 93 + ClientWidth = 846 + TabOrder = 1 + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Panel13 + AnchorSideTop.Control = Panel13 + Left = 0 + Height = 93 + Top = 0 + Width = 151 + AutoSize = True + Caption = 'Statistics' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 73 + ClientWidth = 147 + TabOrder = 0 + object DescChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 123 + Caption = 'Means, Var.''s, S.D.''s' + TabOrder = 0 + end + object CorsChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 123 + Caption = 'Correlations' + TabOrder = 1 + end + object ResidChk: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 123 + Caption = 'Residuals' + TabOrder = 2 + end + end + object TypeGroup: TRadioGroup + AnchorSideLeft.Control = GroupBox1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel13 + Left = 163 + Height = 93 + Top = 0 + Width = 109 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 12 + Caption = 'Type of Coding' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 73 + ClientWidth = 105 + ItemIndex = 1 + Items.Strings = ( + 'Dummy' + 'Effect' + 'Orthogonal' + ) + TabOrder = 1 + end + object Label12: TLabel + AnchorSideLeft.Control = IndOrderBox + AnchorSideTop.Control = Panel13 + Left = 284 + Height = 15 + Top = 0 + Width = 132 + Caption = 'Order of Indep. Var. Entry' + ParentColor = False + end + object IndOrderBox: TListBox + AnchorSideLeft.Control = TypeGroup + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label12 + AnchorSideTop.Side = asrBottom + Left = 284 + Height = 67 + Top = 15 + Width = 149 + BorderSpacing.Left = 12 + ItemHeight = 0 + TabOrder = 2 + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = IndOrderBox + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel13 + Left = 445 + Height = 51 + Top = 0 + Width = 154 + AutoSize = True + BorderSpacing.Left = 12 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ClientHeight = 31 + ClientWidth = 150 + TabOrder = 3 + object ShowDesignChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 126 + Caption = 'Show Design in Grid' + TabOrder = 0 + end + end + end + object Panel14: TPanel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel13 + Left = 0 + Height = 25 + Top = 387 + Width = 862 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BevelOuter = bvNone + ClientHeight = 25 + ClientWidth = 862 + TabOrder = 7 + object ShowModelBtn: TButton + AnchorSideLeft.Control = Panel14 + AnchorSideTop.Control = Panel14 + Left = 8 + Height = 25 + Top = 0 + Width = 92 + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Show Model' + OnClick = ShowModelBtnClick + TabOrder = 0 + end + object ModelEdit: TEdit + AnchorSideLeft.Control = ShowModelBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ShowModelBtn + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Panel14 + AnchorSideRight.Side = asrBottom + Left = 108 + Height = 23 + Top = 1 + Width = 746 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + TabOrder = 1 + Text = 'ModelEdit' + end + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/glmunit.pas b/applications/lazstats/source/forms/analysis/comparisons/glmunit.pas new file mode 100644 index 000000000..a1aff31ec --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/glmunit.pas @@ -0,0 +1,3344 @@ +unit GLMUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + MainUnit, MatrixLib, Globals, OutputUnit, FunctionsLib, + DictionaryUnit, StdCtrls, Buttons, ExtCtrls, ContextHelpUnit; + +type + + { TGLMFrm } + + TGLMFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + Bevel3: TBevel; + HelpBtn: TButton; + Memo2: TLabel; + Panel1: TPanel; + Panel10: TPanel; + Panel11: TPanel; + Panel12: TPanel; + Panel13: TPanel; + Panel14: TPanel; + Panel2: TPanel; + Panel3: TPanel; + Panel4: TPanel; + Panel5: TPanel; + Panel6: TPanel; + Panel7: TPanel; + Panel8: TPanel; + Panel9: TPanel; + ShowDesignChk: TCheckBox; + ContDepInBtn: TBitBtn; + GroupBox2: TGroupBox; + RndIndepOutBtn: TBitBtn; + CovInBtn: TBitBtn; + CovOutBtn: TBitBtn; + ContDepOutBtn: TBitBtn; + CatDepInBtn: TBitBtn; + CatDepOutBtn: TBitBtn; + RepDepInBtn: TBitBtn; + ReptDepOutBtn: TBitBtn; + FixedIndepInBtn: TBitBtn; + FixedIndepOutBtn: TBitBtn; + RndIndepInBtn: TBitBtn; + ContDepCode: TListBox; + CatDepCode: TListBox; + ReptDepCode: TListBox; + FixedIndepCode: TListBox; + RndIndepCode: TListBox; + CovariateCode: TListBox; + RepTrtCode: TListBox; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + DescChk: TCheckBox; + CorsChk: TCheckBox; + Label12: TLabel; + IndOrderBox: TListBox; + TypeGroup: TRadioGroup; + ResidChk: TCheckBox; + EndDefBtn: TButton; + GroupBox1: TGroupBox; + InterDefList: TListBox; + Label11: TLabel; + InteractList: TListBox; + ShowModelBtn: TButton; + DepContList: TListBox; + ModelEdit: TEdit; + FixedList: TListBox; + Label10: TLabel; + Label6: TLabel; + DepCatList: TListBox; + Label7: TLabel; + Label8: TLabel; + Label9: TLabel; + CovariateList: TListBox; + RepTrtList: TListBox; + RandomList: TListBox; + RepeatList: TListBox; + VarList: TListBox; + StartInterBtn: TButton; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + procedure CatDepInBtnClick(Sender: TObject); + procedure CatDepOutBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure ContDepInBtnClick(Sender: TObject); + procedure ContDepOutBtnClick(Sender: TObject); + procedure CovariateListClick(Sender: TObject); + procedure CovInBtnClick(Sender: TObject); + procedure CovOutBtnClick(Sender: TObject); + procedure EndDefBtnClick(Sender: TObject); + procedure FixedIndepInBtnClick(Sender: TObject); + procedure FixedIndepOutBtnClick(Sender: TObject); + procedure FixedListClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure Panel9Resize(Sender: TObject); + procedure RandomListClick(Sender: TObject); + procedure RepDepInBtnClick(Sender: TObject); + procedure ReptDepOutBtnClick(Sender: TObject); + procedure RepTrtListClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure RndIndepInBtnClick(Sender: TObject); + procedure RndIndepOutBtnClick(Sender: TObject); + procedure ShowModelBtnClick(Sender: TObject); + procedure StartInterBtnClick(Sender: TObject); + private + { private declarations } + IntDef : boolean; + DefLine : integer; // number of interaction terms - 1 + NoInterDefs : integer; // number of interactions in the model + NContDep : integer; // no. of continuous dependent variables + NCatDep : integer; // no. of categorical dependent variables + NReptDep : integer; // no. of repeated dependent variables + NFixedIndep : integer; // no. of fixed effect independent variables + NRndIndep : integer; // no. of random effect independent variables + NCovIndep : integer; // no. of covariate independent variables + model : integer; // 1 if multreg, 2 if canonical + novars : integer; // total no. of vectors in analysis grid + totalobs : integer; // total no. of data grid observations + gencount, oldcount : integer; // no. columns generated in datagrid + ContDepID : IntDyneVec; // grid col. no.s of continuous dependent var.s + CatDepID : IntDyneVec; // grid col. no.s of categorical dependent var.s + ReptDepID : IntDyneVec; // grid col. no.s of repeated dep. variables + FixedIndepID : IntDyneVec; // grid col. no.s of fixed independent var.s + RndIndepID : IntDyneVec; // grid col. no.s of random independent var.s + CovIndepID : IntDyneVec; // grid col. no.s of covariates + DataGrid : DblDyneMat; // array for generated vectors and values + GenLabels : StrDyneVec; // array of labels for data matrix + ContDepPos : IntDyneVec; // datagrid position of continuous variables + CatDepPos : IntDyneVec; // beginning datagrid position of categorical var. vectors + ReptDepPos : IntDyneVec; // datagrid position of repeated variable + ReptIndepPos : IntDyneVec; // datagrid pos. of subject vectors + ReptTrtPos : IntDyneVec; // datagrid pos. of repeated treatment vectors + FixedIndepPos : IntDyneVec; // datagrid position of first vector for cat indep. var. + RndIndepPos : IntDyneVec; // datagrid position of first vector for rnd. indep. var. + CovIndepPos : IntDyneVec; // datagrid positions of covariates + InteractPos : IntDyneVec; // datagrid positions of interactions + Labels : StrDyneVec; // labels for the analyses + ColSelected : IntDyneVec; // datagrid columns of variables in the analysis + NFixVecIndep : IntDyneVec; // no. of vectors for fixed independent vars. + NRndVecIndep : IntDyneVec; // no. of vectors for random indep. vars. + NFixVecDep : IntDyneVec; // no. of vectors for fixed dependent vars. + NInteractVecs : IntDyneVec; // no. of vectors for each interaction + OldR2 : double; // Previously obtained R^2 for stepwise addition + R2 : double; // Squared mult. R obtained from RegAnal + rmatrix : DblDyneMat; // correlation matrix + indmatrix : DblDyneMat; // correlations among independent variable + rxy : DblDyneVec; // correlations between dependent and independent var.s + invmatrix : DblDyneMat; // inverse of independent correlations + means : DblDyneVec; // means of variables + Vars : DblDyneVec; // variances of variables + StdDevs : DblDyneVec; // standard deviations of variables + B : DblDyneVec; // raw regression coefficients + Beta : DblDyneVec; // standardized regression coefficients + workmat : DblDyneMat; // work matrix for inverse referenced at 1 (not zero) + TypeISS : DblDyneVec; // Incremental SS + TypeIISS : DblDyneVec; // Unique SS + TypeIMS : DblDyneVec; // Incremental SS + TypeIIMS : DblDyneVec; // Unique MS + TypeIDF1 : DblDyneVec; // numerator d.f. for incremental ms + TypeIIDF1 : DblDyneVec; // numerator d.f. for unique ms + TypeIDF2 : DblDyneVec; // denominator d.f. for incremental ms + TypeIIDF2 : DblDyneVec; // denominator d.f. for unique ms + TypeIF : DblDyneVec; // F for incremental ms + TypeIProb : DblDyneVec; // Probability of F for incremental ms + TypeIIF : DblDyneVec; // F for unique MS + TypeIIProb : DblDyneVec; // Probability for unique ms + + procedure AllocateIDMem; + procedure GetIDs; + function GetVarCount : integer; + procedure AllocateGridMem; + procedure DeallocateGridMem; + procedure DeallocateIDMem; + procedure DummyCodes(min : integer; max : integer; VAR CodePattern : IntDyneMat); + procedure EffectCodes(min : integer; max : integer; VAR CodePattern : IntDyneMat); + procedure OrthogCodes(min : integer; max : integer; VAR CodePattern : IntDyneMat); + procedure RegAnal(Nentered : integer); + procedure PartIEntry; + procedure PartIIEntry; + procedure ModelIAnalysis; + procedure ModelIIAnalysis; + procedure ModelIIIAnalysis; + function CntIntActVecs(linestr : string) : integer; + procedure GenInterVecs(linestr : string); + procedure CanCor(NLeft : integer; NRight : integer; GridPlace : IntDyneVec); + + public + { public declarations } + end; + +var + GLMFrm: TGLMFrm; + +implementation + +uses + Math; + +{ TGLMFrm } + +procedure TGLMFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Items.Clear; + DepCatList.Items.Clear; + DepContList.Items.Clear; + RepeatList.Items.Clear; + RepTrtList.Items.Clear; + RepTrtCode.Items.Clear; + FixedList.Items.Clear; + RandomList.Items.Clear; + CovariateList.Items.Clear; + InterDefList.Items.Clear; + InteractList.Items.Clear; + ContDepCode.Items.Clear; + CatDepCode.Items.Clear; + ReptDepCode.Items.Clear; + FixedIndepCode.Items.Clear; + RndIndepCode.Items.Clear; + CovariateCode.Items.Clear; + IndOrderBox.Items.Clear; + ModelEdit.Text := ''; + NContDep := 0; + NCatDep := 0; + NReptDep := 0; + NFixedIndep := 0; + NRndIndep := 0; + NCovIndep := 0; + DescChk.Checked := false; + CorsChk.Checked := false; + ResidChk.Checked := false; + TypeGroup.ItemIndex := 0; + ContDepOutBtn.Enabled := false; + CatDepOutBtn.Enabled := false; + ReptDepOutBtn.Enabled := false; + FixedIndepOutBtn.Enabled := false; + RndIndepOutBtn.Enabled := false; + CovOutBtn.Enabled := false; + IntDef := false; + DefLine := 0; + NoInterDefs := 0; + for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TGLMFrm.RndIndepInBtnClick(Sender: TObject); +var + index : integer; + codestr : string; + +begin + index := VarList.ItemIndex; + if index >= 0 then + begin + RandomList.Items.Add(VarList.Items.Strings[index]); + VarList.Items.Delete(index); + NRndIndep := NRndIndep + 1; + codestr := format('IR%d',[NRndIndep]); + RndIndepCode.Items.Add(codestr); + IndOrderBox.Items.Add(codestr); + RndIndepOutBtn.Enabled := true; + end; +end; + +procedure TGLMFrm.RndIndepOutBtnClick(Sender: TObject); +var + i, index : integer; + cellstring : string; + +begin + index := RandomList.ItemIndex; + if index >= 0 then + begin + VarList.Items.Add(RandomList.Items.Strings[index]); + RandomList.Items.Delete(index); + cellstring := RndIndepCode.Items.Strings[index]; + RndIndepCode.Items.Delete(index); + for i := 0 to IndOrderBox.Items.Count - 1 do + if cellstring = IndOrderBox.Items.Strings[i] then + IndOrderBox.Items.Delete(i); + NRndIndep := NRndIndep - 1; + if RandomList.ItemIndex < 0 then RndIndepOutBtn.Enabled := false; + end; +end; + +procedure TGLMFrm.ShowModelBtnClick(Sender: TObject); +var + i : integer; + codestr : string; + +begin + // add all dependent variable codes + if NContDep > 0 then + begin + for i := 0 to NContDep - 1 do + begin + ModelEdit.Text := ModelEdit.Text + ContDepCode.Items.Strings[i]; + if i < NContDep - 1 then ModelEdit.Text := ModelEdit.Text + ' + '; + end; + end; + if NCatDep > 0 then + begin + if ModelEdit.Text <> '' then ModelEdit.Text := ModelEdit.Text + ' + '; + for i := 0 to NCatDep - 1 do + begin + ModelEdit.Text := ModelEdit.Text + CatDepCode.Items.Strings[i]; + if i < NCatDep - 1 then ModelEdit.Text := ModelEdit.Text + ' + '; + end; + end; + if NReptDep > 0 then + begin + if ModelEdit.Text <> '' then ModelEdit.Text := ModelEdit.Text + ' + '; + ModelEdit.Text := ModelEdit.Text + 'Rep'; + end; + + // now add the independent variable codes + ModelEdit.Text := ModelEdit.Text + ' = '; + if NFixedIndep > 0 then + begin + for i := 0 to NFixedIndep - 1 do + begin + ModelEdit.Text := ModelEdit.Text + FixedIndepCode.Items.Strings[i]; + if i < NFixedIndep - 1 then + ModelEdit.Text := ModelEdit.Text + ' + '; + end; + end; + if NRndIndep > 0 then + begin + if NFixedIndep > 0 then ModelEdit.Text := ModelEdit.Text + ' + '; + for i := 0 to NRndIndep - 1 do + begin + ModelEdit.Text := ModelEdit.Text + RndIndepCode.Items.Strings[i]; + if i < NRndIndep - 1 then + ModelEdit.Text := ModelEdit.Text + ' + '; + end; + end; + if NCovIndep > 0 then + begin + if (NFixedIndep > 0) or (NRndIndep > 0) then + ModelEdit.Text := ModelEdit.Text + ' + '; + for i := 0 to NCovIndep - 1 do + begin + ModelEdit.Text := ModelEdit.Text + CovariateCode.Items.Strings[i]; + if i < NCovIndep - 1 then + ModelEdit.Text := ModelEdit.Text + ' + '; + end; + end; + + // now add interactions + if NoInterDefs > 0 then + begin + ModelEdit.Text := ModelEdit.Text + ' + '; + for i := 0 to NoInterDefs - 1 do + begin + ModelEdit.Text := ModelEdit.Text + InterActList.Items.Strings[i]; + if i < NoInterDefs - 1 then + ModelEdit.Text := ModelEdit.Text + ' + '; + end; + end; + + // Now add person vectors + if NReptDep > 0 then + begin + ModelEdit.Text := ModelEdit.Text + ' + '; + for i := 0 to NReptDep - 1 do + begin + codestr := format('IP%d',[i+1]); + ModelEdit.Text := ModelEdit.Text + codestr; + if i < NReptDep - 1 then + ModelEdit.Text := ModelEdit.Text + ' + '; + end; + end; + // Now add repeated treatments + if NReptDep > 0 then + begin + ModelEdit.Text := ModelEdit.Text + ' + '; + for i := 0 to NReptDep - 1 do + begin + codestr := format('IR%d',[i+1]); + ModelEdit.Text := ModelEdit.Text + codestr; + if i < NReptDep - 1 then + ModelEdit.Text := ModelEdit.Text + ' + '; + end; + end; +end; + +procedure TGLMFrm.StartInterBtnClick(Sender: TObject); +begin + IntDef := true; +end; + +procedure TGLMFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure TGLMFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TGLMFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TGLMFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TGLMFrm.RandomListClick(Sender: TObject); +VAR index : integer; +begin + if IntDef then + begin + index := RandomList.ItemIndex; + InterDefList.Items.Add(RndIndepCode.Items.Strings[index]); + DefLine := DefLine + 1; // counter for number of terms - 1 + end; +end; + +procedure TGLMFrm.RepDepInBtnClick(Sender: TObject); +var + index, i : integer; + codestr : string; + +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + RepeatList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + NReptDep := NReptDep + 1; + codestr := format('DR%d',[NReptDep]); + if NReptDep = 1 then + begin + ReptDepCode.Items.Add(codestr); + codestr := format('IP%d',[NReptDep]); + IndOrderBox.Items.Add(codestr); + codestr := format('IR%d',[NReptDep]); + IndOrderBox.Items.Add(codestr); + RepTrtCode.Items.Add(codestr); + codestr := format('Rep.Trt.%d',[NReptDep]); + RepTrtList.Items.Add(codestr); + end; + index := index - 1; + i := 0; + end + else i := i + 1; + end; + ReptDepOutBtn.Enabled := true; +end; + +procedure TGLMFrm.ReptDepOutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := RepeatList.ItemIndex; + if index >= 0 then + begin + VarList.Items.Add(RepeatList.Items.Strings[index]); + RepeatList.Items.Delete(index); + ReptDepCode.Items.Delete(index); + NReptDep := NReptDep - 1; + if RepeatList.ItemIndex < 0 then ReptDepOutBtn.Enabled := false; + end; +end; + +procedure TGLMFrm.RepTrtListClick(Sender: TObject); +VAR index : integer; +begin + if IntDef then + begin + index := RepTrtList.ItemIndex; + InterDefList.Items.Add(RepTrtCode.Items.Strings[index]); + DefLine := DefLine + 1; // counter for number of terms + end; +end; + +procedure TGLMFrm.ContDepInBtnClick(Sender: TObject); +var + index : integer; + codestr : string; + +begin + index := VarList.ItemIndex; + if index >= 0 then + begin + DepContList.Items.Add(VarList.Items.Strings[index]); + VarList.Items.Delete(index); + ContDepOutBtn.Enabled := true; + NContDep := NContDep + 1; + codestr := format('DC%d',[NContDep]); + ContDepCode.Items.Add(codestr); + end; +end; + +procedure TGLMFrm.CatDepInBtnClick(Sender: TObject); +var + index : integer; + codestr : string; + +begin + index := VarList.ItemIndex; + if index >= 0 then + begin + DepCatList.Items.Add(VarList.Items.Strings[index]); + VarList.Items.Delete(index); + NCatDep := NCatDep + 1; + codestr := format('DF%d',[NCatDep]); + CatDepCode.Items.Add(codestr); + CatDepOutBtn.Enabled := true; + end; +end; + +procedure TGLMFrm.CatDepOutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := DepCatList.ItemIndex; + if index >= 0 then + begin + VarList.Items.Add(DepCatList.Items.Strings[index]); + DepCatList.Items.Delete(index); + CatDepCode.Items.Delete(index); + NCatDep := NCatDep - 1; + if DepCatList.ItemIndex < 0 then CatDepOutBtn.Enabled := false; + end; +end; + +procedure TGLMFrm.ComputeBtnClick(Sender: TObject); +var + i, j : integer; // no. of variables in the analysis + cellstring : string; + +begin + if (NContDep > 0) and (NReptDep > 0) then + begin + ShowMessage('ERROR! One cannot have both continuous and repeated dependent variables!'); + exit; + end; + gencount := 0; // counter for generated variables + totalobs := 0; // initialize total no. of observations in data grid + AllocateIDMem; // get heap space for arrays + GetIDs; // get var. no.s of dependent and independent variables + novars := GetVarCount; // get total no. of variables to generate + AllocateGridMem; // create data array for values and codes + // Note, the Data Grid first subscript is row (subject) and second the var. + if (NCatDep > 0) or (NContDep > 1) then model := 2 + else model := 1; // use mult.reg for model 1, canonical reg. for model 2 + if NReptDep > 0 then model := 3; + + // This procedure first creates the vectors of dependent variables then the + // vectors for independent variables. A case no. is placed in the first + // column of a data grid followed by the dependent variables and then the + // independent variables. If multiple dependent variables are created, the + // type of analysis is a canonical correlation analysis, otherwise a + // multiple regression analysis. Analyses are performed to obtain both + // Type I SS's and Type II SS's (stepwise addition and unique contribution) + + // PART I. ENTRY OF DEPENDENT VARIABLES (AND OBSERVATION NO.) + // Place case labels in data grid and for repeated measures, spread out + // the repeated measures over NoCases * No. repeated measures + PartIEntry; + + // PART II. CREATION OF INDEPENDENT VARIABLE VECTORS + // First, if there are repeated measures, generate (n - 1) person vectors + PartIIEntry; + + // Now, do the analyses + if model = 1 then ModelIAnalysis; // models with 1 dependent variable + if model = 2 then ModelIIAnalysis; // models with 2 or more dependent var.s + if model = 3 then ModelIIIAnalysis; // Repeated measures designs + + // Place generated data into the main form's grid + if ShowDesignChk.Checked then + begin + if NoVariables < gencount then + begin + j := NoVariables; + for i := j+1 to gencount do + begin + DictionaryFrm.NewVar(j); + end; + end; + OS3MainFrm.DataGrid.RowCount := totalobs+1; + for i := 1 to totalobs do + for j := 1 to gencount do + OS3MainFrm.DataGrid.Cells[j,i] := FloatToStr(DataGrid[i-1,j-1]); + for i := 1 to gencount do + begin + OS3MainFrm.DataGrid.Cells[i,0] := GenLabels[i-1]; + DictionaryFrm.Defaults(Self,i); + DictionaryFrm.DictGrid.Cells[1,i] := GenLabels[i-1]; + end; + for i := 1 to totalobs do + begin + cellstring := format('CASE%d',[i]); + OS3MainFrm.DataGrid.Cells[0,i] := cellstring; + end; + OS3MainFrm.NoCasesEdit.Text := IntToStr(totalobs); + OS3MainFrm.NoVarsEdit.Text := IntToStr(gencount); + NoVariables := gencount; + NoCases := totalobs; + OS3MainFrm.FileNameEdit.Text := ''; + end; + + DeallocateGridMem; // free up heap allocated to data array + DeallocateIDMem; // free up heap space +end; + +procedure TGLMFrm.ContDepOutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := DepContList.ItemIndex; + if index >= 0 then + begin + VarList.Items.Add(DepContList.Items.Strings[index]); + DepContList.Items.Delete(index); + ContDepCode.Items.Delete(index); + NContDep := NContDep - 1; + if DepContList.ItemIndex < 0 then ContDepOutBtn.Enabled := false; + end; +end; + +procedure TGLMFrm.CovariateListClick(Sender: TObject); +VAR index : integer; +begin + if IntDef then + begin + index := CovariateList.ItemIndex; + InterDefList.Items.Add(CovariateCode.Items.Strings[index]); + DefLine := DefLine + 1; // counter for number of terms - 1 + end; +end; + +procedure TGLMFrm.CovInBtnClick(Sender: TObject); +var + index : integer; + codestr : string; + +begin + index := VarList.ItemIndex; + if index >= 0 then + begin + CovariateList.Items.Add(VarList.Items.Strings[index]); + VarList.Items.Delete(index); + NCovIndep := NCovIndep + 1; + codestr := format('IC%d',[NCovIndep]); + CovariateCode.Items.Add(codestr); + IndOrderBox.Items.Add(codestr); + CovOutBtn.Enabled := true; + end; +end; + +procedure TGLMFrm.CovOutBtnClick(Sender: TObject); +var + i, index : integer; + cellstring : string; + +begin + index := CovariateList.ItemIndex; + if index >= 0 then + begin + VarList.Items.Add(CovariateList.Items.Strings[index]); + CovariateList.Items.Delete(index); + cellstring := CovariateCode.Items.Strings[index]; + CovariateCode.Items.Delete(index); + for i := 0 to IndOrderBox.Items.Count - 1 do + if cellstring = IndOrderBox.Items.Strings[i] then + IndOrderBox.Items.Delete(i); + NCovIndep := NCovIndep - 1; + if CovariateList.ItemIndex < 0 then CovOutBtn.Enabled := false; + end; +end; + +procedure TGLMFrm.EndDefBtnClick(Sender: TObject); +var + index : integer; + nolines : integer; + LineStr : string; + +begin + LineStr := ''; + nolines := InterDefList.Items.Count; + if nolines > 0 then + begin + for index := 0 to nolines - 1 do + begin + LineStr := LineStr + InterDefList.Items.Strings[index]; + if index < nolines - 1 then LineStr := LineStr + ' * '; + end; + InteractList.Items.Add(LineStr); + IndOrderBox.Items.Add(LineStr); + NoInterDefs := NoInterDefs + 1; + end; + InterDefList.Clear; +end; + +procedure TGLMFrm.FixedIndepInBtnClick(Sender: TObject); +var + index, i : integer; + codestr : string; + +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + FixedList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + NFixedIndep := NFixedIndep + 1; + codestr := format('IF%d',[NFixedIndep]); + FixedIndepCode.Items.Add(codestr); + IndOrderBox.Items.Add(codestr); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + FixedIndepOutBtn.Enabled := true; +end; + +procedure TGLMFrm.FixedIndepOutBtnClick(Sender: TObject); +var + i, index : integer; + cellstring : string; + +begin + index := FixedList.ItemIndex; + if index >= 0 then + begin + VarList.Items.Add(FixedList.Items.Strings[index]); + FixedList.Items.Delete(index); + cellstring := FixedIndepCode.Items.Strings[index]; + FixedIndepCode.Items.Delete(index); + NFixedIndep := NFixedIndep - 1; + for i := 0 to IndOrderBox.Items.Count - 1 do + if IndOrderBox.Items.Strings[i] = cellstring then + IndOrderBox.Items.Delete(i); + if FixedList.ItemIndex < 0 then FixedIndepOutBtn.Enabled := false; + end; +end; + +procedure TGLMFrm.FixedListClick(Sender: TObject); +VAR index : integer; +begin + if IntDef then + begin + index := FixedList.ItemIndex; + InterDefList.Items.Add(FixedIndepCode.Items.Strings[index]); + DefLine := DefLine + 1; // counter for number of terms + end; +end; + +procedure TGLMFrm.AllocateIDMem; +begin + if NContDep > 0 then + begin + SetLength(ContDepID,NContDep); + SetLength(ContDepPos,NContDep); + end; + if NCatDep > 0 then + begin + SetLength(CatDepID,NCatDep); + SetLength(CatDepPos,NCatDep); + SetLength(NFixVecDep,NCatDep); + end; + if NReptDep > 0 then + begin + SetLength(ReptDepID,NReptDep); + SetLength(ReptDepPos,NReptDep); + SetLength(ReptIndepPos,NoCases); + SetLength(ReptTrtPos,NReptDep); + end; + if NFixedIndep > 0 then + begin + SetLength(FixedIndepID,NFixedIndep); + SetLength(FixedIndepPos,NFixedIndep); + SetLength(NFixVecIndep,NFixedIndep); + end; + if NRndIndep > 0 then + begin + SetLength(RndIndepID,NRndIndep); + SetLength(RndIndepPos,NRndIndep); + SetLength(NRndVecIndep,NRndIndep); + end; + if NCovIndep > 0 then + begin + SetLength(CovIndepID,NCovIndep); + SetLength(CovIndepPos,NCovIndep); + end; + if NoInterDefs > 0 then + begin + SetLength(NInteractVecs,NoInterDefs); + SetLength(InteractPos,NoInterDefs); + end; +end; + +procedure TGLMFrm.GetIDs; +var + cellstring : string; + i, j : integer; + +begin + if NContDep > 0 then + begin + for i := 0 to NContDep - 1 do + begin + cellstring := DepContList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + ContDepID[i] := j; + end; + end; + end; + if NCatDep > 0 then + begin + for i := 0 to NCatDep - 1 do + begin + cellstring := DepCatList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + CatDepID[i] := j; + end; + end; + end; + if NReptDep > 0 then + begin + for i := 0 to NReptDep - 1 do + begin + cellstring := RepeatList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + ReptDepID[i] := j; + end; + end; + end; + if NFixedIndep > 0 then + begin + for i := 0 to NFixedIndep - 1 do + begin + cellstring := FixedList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + FixedIndepID[i] := j; + end; + end; + end; + if NRndIndep > 0 then + begin + for i := 0 to NRndIndep - 1 do + begin + cellstring := RandomList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + RndIndepID[i] := j; + end; + end; + end; + if NCovIndep > 0 then + begin + for i := 0 to NCovIndep - 1 do + begin + cellstring := CovariateList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + CovIndepID[i] := j; + end; + end; + end; +end; + +function TGLMFrm.GetVarCount: integer; +var + count, i, j, col, nvectors : integer; + min, max : integer; // use to get no. of coding vectors for categorical var.s + group : integer; + linestr : string; + +begin + count := 1; // one column for case id's + count := count + NContDep + NCovIndep; // sum of continuous variables + if NReptDep > 0 then count := count + 1; // one col. for repeated dep. measure + // plus person vectors for repeated measures (independent predictors) + if NReptDep > 0 then count := count + (NoCases - 1); // person vectors + if NReptDep > 0 then count := count + (NreptDep - 1); // repeated treatment vectors + if NCatDep > 0 then // calculate min and max for each var. to get no. of vectors + begin + for i := 0 to NCatDep - 1 do + begin + col := CatDepID[i]; + min := round(StrToFloat(OS3MainFrm.DataGrid.Cells[col,1])); + max := min; + for j := 1 to NoCases do + begin + group := round(StrToFLoat(OS3MainFrm.DataGrid.Cells[col,j])); + if group < min then min := group; + if group > max then max := group; + end; + count := count + (max - min); // 1 less than the no. of groups + NFixVecDep[i] := count; + end; + end; + + if NFixedIndep > 0 then // add no. of vectors to count + begin + for i := 0 to NFixedIndep - 1 do + begin + col := FixedIndepID[i]; + min := round(StrToFloat(OS3MainFrm.DataGrid.Cells[col,1])); + max := min; + for j := 1 to NoCases do + begin + group := round(StrToFloat(OS3MainFrm.DataGrid.Cells[col,j])); + if group < min then min := group; + if group > max then max := group; + end; + count := count + (max - min); // 1 less than the no. of groups + NFixVecIndep[i] := max - min; + end; + end; + + if NRndIndep > 0 then // add no. of vectors to count + begin + for i := 0 to NRndIndep - 1 do + begin + col := RndIndepID[i]; + min := round(StrToFloat(OS3MainFrm.DataGrid.Cells[col,1])); + max := min; + for j := 1 to NoCases do + begin + group := round(StrToFloat(OS3MainFrm.DataGrid.Cells[col,j])); + if group < min then min := group; + if group > max then max := group; + end; + count := count + (max - min); // 1 less than the no. of groups + NRndVecIndep[i] := max - min; + end; + end; + + if NoInterDefs > 0 then // get no. of vectors for each interaction + begin + for i := 0 to NoInterDefs - 1 do + begin + linestr := InterActList.Items.Strings[i]; + // parse the line for variable definitions and get no. of columns + // and vectors for the products of these variables + nvectors := CntIntActVecs(linestr); + NInteractVecs[i] := nvectors; + count := count + nvectors; + end; + end; + Result := count; +end; + +procedure TGLMFrm.AllocateGridMem; +var + norows : integer; + +begin + if NReptDep > 0 then norows := NoCases * NReptDep + else norows := NoCases; + SetLength(DataGrid,norows+1,novars+4); // grid data for generated data + SetLength(GenLabels,novars+4); // column labels of new data grid + SetLength(Labels,novars+4); // labels of variables entered into analysis + SetLength(ColSelected,novars+4); // datagrid columns selected for analysis +end; + +procedure TGLMFrm.DeallocateGridMem; +begin + ColSelected := nil; + Labels := nil; + GenLabels := nil; + DataGrid := nil; +end; + +procedure TGLMFrm.DeallocateIDMem; +begin + InteractPos := nil; + NInteractVecs := nil; + CovIndepPos := nil; + CovIndepID := nil; + NRndVecIndep := nil; + RndIndepPos := nil; + RndIndepID := nil; + NFixVecIndep := nil; + FixedIndepPos := nil; + FixedIndepID := nil; + ReptTrtPos := nil; + ReptIndepPos := nil; + ReptDepPos := nil; + ReptDepID := nil; + NFixVecDep := nil; + CatDepPos := nil; + CatDepID := nil; + ContDepPos := nil; + ContDepID := nil; +end; + +procedure TGLMFrm.DummyCodes(min: integer; max: integer; + var CodePattern: IntDyneMat); +var + ngrps : integer; + vects : integer; + i, j : integer; + +begin + ngrps := max - min + 1; + vects := ngrps - 1; + for j := 1 to vects do + begin + for i := 1 to ngrps do + begin + if i = j then CodePattern[i,j] := 1 else CodePattern[i,j] := 0; + end; + end; +end; + +procedure TGLMFrm.EffectCodes(min: integer; max: integer; + var CodePattern: IntDyneMat); +var + ngrps : integer; + vects : integer; + i, j : integer; + +begin + ngrps := max - min + 1; + vects := ngrps - 1; + for i := 1 to ngrps do + begin + for j := 1 to vects do + begin + if i = j then CodePattern[i,j] := 1; + if i = ngrps then CodePattern[i,j] := -1; + if (i <> j) and (i <> ngrps) then CodePattern[i,j] := 0; + end; + end; +end; + +procedure TGLMFrm.OrthogCodes(min: integer; max: integer; + var CodePattern: IntDyneMat); +var + ngrps : integer; + vects : integer; + i, j : integer; + +begin + ngrps := max - min + 1; + vects := ngrps - 1; + for i := 1 to ngrps do + begin + for j := 1 to vects do + begin + if i <= j then CodePattern[i,j] := 1; + if i-1 = j then CodePattern[i,j] := -j; + if i > j+1 then CodePattern[i,j] := 0; + end; + end; +end; + +procedure TGLMFrm.Panel9Resize(Sender: TObject); +begin + Bevel3.Constraints.MinHeight := Panel8.Height; +end; + +procedure TGLMFrm.RegAnal(Nentered: integer); +var + i, j, nvars, ncases : integer; + title : string; + +begin + nvars := Nentered; + ncases := totalobs; + SetLength(rmatrix,nvars+1,nvars+1); + SetLength(indmatrix,nvars-1,nvars-1); + SetLength(rxy,nvars); + SetLength(invmatrix,nvars,nvars); + SetLength(B,nvars); + SetLength(Beta,nvars); + SetLength(means,nvars); + SetLength(Vars,nvars); + SetLength(StdDevs,nvars); + SetLength(workmat,nvars,nvars); + + DynCorrelations(nvars,ColSelected,DataGrid,rmatrix,means,vars,StdDevs,ncases,3); + OutputFrm.RichEdit.Clear; + title := 'Means'; + if DescChk.Checked then DynVectorPrint(means,Nentered,title,Labels,ncases); + title := 'Correlations'; + if CorsChk.Checked then + MAT_PRINT(rmatrix,Nentered,Nentered,title,Labels,Labels,ncases); + for i := 1 to nvars - 1 do + begin + rxy[i-1] := rmatrix[i,0]; // r's with dependent var + for j := 1 to nvars - 1 do + begin + indmatrix[i-1,j-1] := rmatrix[i,j]; // intercorr.s of indep. var.s + workmat[i-1,j-1] := rmatrix[i,j]; // used to get inverse + end; + end; + SVDinverse(workmat,nvars-1); + // Copy inverse to zero indexed matrix + for i := 1 to nvars-1 do + for j := 1 to nvars-1 do invmatrix[i-1,j-1] := workmat[i-1,j-1]; + title := 'inverse of indep. matrix'; + // get betas and squared multiple correlation + R2 := 0.0; + for i := 1 to nvars-1 do + begin + Beta[i-1] := 0.0; + for j := 1 to nvars-1 do Beta[i-1] := Beta[i-1] + invmatrix[i-1,j-1] * rxy[j-1]; + R2 := R2 + Beta[i-1] * rxy[i-1]; + end; +// outline := format('Squared Multiple Correlation = %6.4f',[R2]); +// OutputFrm.RichEdit.Lines.Add(outline); +// title := 'Standardized regression coefficients'; +// DynVectorPrint(Beta,Nentered-1,title,Labels,ncases); + // get raw coefficients + for i := 1 to nvars - 1 do + begin + if StdDevs[i] > 0.0 then + B[i-1] := Beta[i-1] * (StdDevs[0] / StdDevs[i]) + else B[i-1] := 0.0; + end; +// title := 'Raw regression coefficients'; +// DynVectorPrint(B,Nentered-1,title,Labels,ncases); +// OutputFrm.ShowModal; +end; + +procedure TGLMFrm.PartIEntry; +var + i, j, k, vect : integer; + min, max, group, ngrps : integer; + CodePattern : IntDyneMat; + cellstring: string; + +begin + if NReptDep > 0 then // create observations for each replication of the N cases + begin + for i := 1 to NreptDep do + begin + ReptDepPos[i-1] := i; // datagrid pos. of a repeated measure + for j := 1 to NoCases do + begin + DataGrid[totalobs,gencount] := j; // case no. in col. 0 + k := ReptDepID[i-1]; + DataGrid[totalobs,gencount+1] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,j])); + totalobs := totalobs + 1; + end; + end; // next i repeated measure + gencount := gencount + 2; + end + else + begin // no repeated measures - just need case numbers in data grid pos 0 + for i := 1 to NoCases do DataGrid[i-1,gencount] := i; + totalobs := NoCases; + gencount := gencount + 1; + end; + GenLabels[0] := 'Obs.'; + if NReptDep > 0 then GenLabels[1] := 'Repeated'; + + // Enter the continuous dependent variables into the data grid + if NContDep > 0 then + begin + for j := 1 to NContDep do + begin + ContDepPos[j-1] := gencount; + for i := 1 to NoCases do + begin + k := ContDepID[j-1]; + DataGrid[i-1,gencount] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i])); + end; + GenLabels[gencount] := ContDepCode.Items.Strings[j-1]; + gencount := gencount + 1; + end; + end; // end if NContDep > 0 + + // Enter categorical dependent variables in the data grid + if NCatDep > 0 then + begin + // get no. of categories - 1 for no of vectors to generate for each + // categorical variable + for j := 1 to NCatDep do + begin + CatDepPos[j-1] := gencount; + k := CatDepID[j-1]; + min := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,1]))); + max := min; + for i := 1 to NoCases do + begin + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i]))); + if group > max then max := group; + if group < min then min := group; + end; + ngrps := max-min+1; + SetLength(CodePattern,ngrps+1,ngrps+1); + if TypeGroup.ItemIndex = 0 then // dummy coding + DummyCodes(min,max,CodePattern); + if TypeGroup.ItemIndex = 1 then // effect coding + EffectCodes(min,max,CodePattern); + if TypeGroup.ItemIndex = 2 then // orthogonal coding + OrthogCodes(min,max,CodePattern); + // Now, generate vectors for the categorical variable j + for vect := 1 to (max - min) do // vector no. + begin + for i := 1 to NoCases do + begin + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i]))); + DataGrid[i-1,gencount + vect - 1] := CodePattern[group,vect]; + end; + cellstring := format('%s_%d',[CatDepCode.Items.Strings[j-1],vect]); + GenLabels[gencount + vect - 1] := cellstring; + end; + gencount := gencount + (max - min); // new no. of variables + end; // next categorical variable j + end; // if no. of dependent categorical variables greater than zero + codepattern := nil; +end; + +procedure TGLMFrm.PartIIEntry; +var + i, j, k, vect, lastdep, row : integer; + min, max, group, ngrps : integer; + CodePattern : IntDyneMat; + cellstring : string; + value : double; + +begin + lastdep := gencount; // datagrid position of last dependent variable + // This section develops vectors for the independent variables. If there + // are repeated measures, generate person vectors first. + if NReptDep > 0 then + begin + min := 1; + max := NoCases; + ngrps := max-min+1; + SetLength(CodePattern,ngrps+1,ngrps+1); + if TypeGroup.ItemIndex = 0 then // dummy coding + DummyCodes(min,max,CodePattern); + if TypeGroup.ItemIndex = 1 then // effect coding + EffectCodes(min,max,CodePattern); + if TypeGroup.ItemIndex = 2 then // orthogonal coding + OrthogCodes(min,max,CodePattern); + for vect := 1 to (max - min) do // vector no. + begin + for i := 1 to totalobs do // NoCases + begin + group := round(DataGrid[i-1,0]); + DataGrid[i-1,gencount + vect - 1] := CodePattern[group,vect]; + end; + ReptIndepPos[vect-1] := gencount + vect - 1; + cellstring := format('p%d',[vect]); + GenLabels[gencount + vect - 1] := cellstring; + end; + gencount := gencount + (max - min); // new no. of variables + end; // end generation of person codes + + // generate vectors for the repeated treatments if replications used + if NReptDep > 0 then + begin + min := 1; + max := NReptDep; + ngrps := max-min+1; + SetLength(CodePattern,ngrps+1,ngrps+1); + if TypeGroup.ItemIndex = 0 then // dummy coding + DummyCodes(min,max,CodePattern); + if TypeGroup.ItemIndex = 1 then // effect coding + EffectCodes(min,max,CodePattern); + if TypeGroup.ItemIndex = 2 then // orthogonal coding + OrthogCodes(min,max,CodePattern); + for vect := 1 to (max - min) do // vector no. + begin + for i := 1 to totalobs do // NoCases + begin + group := ((i - 1) div NoCases) + 1; + DataGrid[i-1,gencount + vect - 1] := CodePattern[group,vect]; + end; + ReptTrtPos[vect-1] := gencount + vect - 1; + cellstring := format('IR_%d',[vect]); + GenLabels[gencount + vect - 1] := cellstring; + end; + gencount := gencount + (max - min); // new no. of variables + end; + + oldcount := gencount; + // Next, add vectors for independent fixed categorical variables + if NFixedIndep > 0 then + begin + // get no. of categories - 1 for no of vectors to generate for each + // categorical variable + for j := 1 to NFixedIndep do + begin + FixedIndepPos[j-1] := gencount; // first vector position in datagrid + k := FixedIndepID[j-1]; + min := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,1]))); + max := min; + for i := 1 to NoCases do + begin + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i]))); + if group > max then max := group; + if group < min then min := group; + end; + ngrps := max-min+1; + SetLength(CodePattern,ngrps+1,ngrps+1); + if TypeGroup.ItemIndex = 0 then // dummy coding + DummyCodes(min,max,CodePattern); + if TypeGroup.ItemIndex = 1 then // effect coding + EffectCodes(min,max,CodePattern); + if TypeGroup.ItemIndex = 2 then // orthogonal coding + OrthogCodes(min,max,CodePattern); + // Now, generate vectors for the categorical variable j + for vect := 1 to (max - min) do // vector no. + begin + for i := 1 to NoCases do + begin + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i]))); + DataGrid[i-1,gencount + vect - 1] := CodePattern[group,vect]; + end; + cellstring := format('%s_%d',[FixedIndepCode.Items.Strings[j-1],vect]); + GenLabels[gencount + vect - 1] := cellstring; + end; + gencount := gencount + (max - min); // new no. of variables + end; // next categorical variable j + end; // end generation of fixed effect codes + + // Next, add vectors for independent random categorical variables + oldcount := gencount; + if NRndIndep > 0 then + begin + // get no. of categories - 1 for no of vectors to generate for each + // categorical variable + for j := 1 to NRndIndep do + begin + RndIndepPos[j-1] := gencount; // pos. of first vector in datagrid + k := RndIndepID[j-1]; + min := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,1]))); + max := min; + for i := 1 to NoCases do + begin + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i]))); + if group > max then max := group; + if group < min then min := group; + end; + ngrps := max-min+1; + SetLength(CodePattern,ngrps+1,ngrps+1); + if TypeGroup.ItemIndex = 0 then // dummy coding + DummyCodes(min,max,CodePattern); + if TypeGroup.ItemIndex = 1 then // effect coding + EffectCodes(min,max,CodePattern); + if TypeGroup.ItemIndex = 2 then // orthogonal coding + OrthogCodes(min,max,CodePattern); + // Now, generate vectors for the categorical variable j + for vect := 1 to (max - min) do // vector no. + begin + for i := 1 to NoCases do + begin + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i]))); + DataGrid[i-1,gencount + vect - 1] := CodePattern[group,vect]; + end; + cellstring := format('%s_%d',[RndIndepCode.Items.Strings[j-1],vect]); + GenLabels[gencount + vect - 1] := cellstring; + end; + gencount := gencount + (max - min); // new no. of variables + end; // next categorical variable j + end; // end generation of random effect codes + + + // Next, add covariates + if NCovIndep > 0 then + begin + for j := 1 to NCovIndep do + begin + CovIndepPos[j-1] := gencount; + for i := 1 to NoCases do + begin + k := CovIndepID[j-1]; + DataGrid[i-1,gencount] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i])); + end; + GenLabels[gencount] := CovariateCode.Items.Strings[j-1]; + gencount := gencount + 1; + end; + end; // end generation of covariate codes + + // if repeated measures used, copy generated vectors for each replication + if NReptDep > 0 then + begin + for j := 1 to NReptDep - 1 do + begin + for i := 1 to NoCases do + begin + for k := lastdep + (NoCases-1) +(NReptDep-1) + 1 to gencount do + begin + value := DataGrid[i-1,k-1]; + row := (j * NoCases) + i - 1; + DataGrid[row,k-1] := value; + end; // next k column in data grid + end; // next case + end; // next repeated measure + end; // if repeated measures used + + // Now generate product vectors for the interactions + if NoInterDefs > 0 then + begin + for j := 0 to NoInterDefs - 1 do + begin + // parse an interaction line into components (abbreviations) and + // get product of vectors corresponding to each + InteractPos[j] := gencount; + cellstring := InteractList.Items.Strings[j]; + GenInterVecs(cellstring); + gencount := gencount + NInteractVecs[j]; + end; + end; // end generation of interaction codes + codepattern := nil; +end; + +procedure TGLMFrm.ModelIAnalysis; +var + block, i, j, k, NEntered, index, noblocks, priorentered : integer; + cellstring : string; + labelstr : string; + outline : string; + R, R2Increment, SSx, sum, constant, FullR2 : double; + df1, df2, F, FProbF, StdErrB,OldDF1, PredSS, PredMS : double; + SSt, VarEst, SSres, StdErrEst, AdjR2 : double; + +begin + NEntered := 0; + OldDF1 := 0.0; + priorentered := 0; + OldR2 := 0; + // enter the dependent variable first + if NContDep > 0 then + begin + ColSelected[0] := ContDepPos[0]; + Labels[0] := GenLabels[1]; + end + else begin + ColSelected[0] := ReptDepPos[0]; + Labels[0] := GenLabels[1]; + end; + NEntered := NEntered + 1; + + // Enter independent variables as indicated in indorderbox then interactions + // until the total model is analyzed. Then delete each term to get a + // restricted model and compare to the full model. + noblocks := IndOrderBox.Items.Count; + SetLength(TypeISS,noblocks); + SetLength(TypeIISS,noblocks); + SetLength(TypeIMS,noblocks); + SetLength(TypeIIMS,noblocks); + SetLength(TypeIDF1,noblocks); + SetLength(TypeIDF2,noblocks); + SetLength(TypeIIDF1,noblocks); + SetLength(TypeIIDF2,noblocks); + SetLength(TypeIF,noblocks); + SetLength(TypeIProb,noblocks); + SetLength(TypeIIF,noblocks); + SetLength(TypeIIProb,noblocks); + + for block := 0 to noblocks - 1 do + begin + // get index of the abbreviation of term to enter and find corresponding + // vector(s) to place in the equation + cellstring := IndOrderBox.Items.Strings[block]; + // check for covariates first + if NCovIndep > 0 then + begin + for i := 0 to NCovIndep-1 do + begin + if cellstring = CovariateCode.Items.Strings[i] then // matched! + begin + index := i; // index of covariate code + ColSelected[NEntered] := CovIndepPos[index]; + labelstr := format('%s',[CovariateCode.Items.Strings[index]]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + break; + end; + end; + end; + // check for fixed effect variables next + if NFixedIndep > 0 then + begin + for i := 0 to NFixedIndep-1 do + begin + if cellstring = FixedIndepCode.Items.Strings[i] then + begin + index := i; + for j := 0 to NFixVecIndep[index]-1 do + begin + ColSelected[NEntered] := FixedIndepPos[index] + j; + labelstr := format('%s_%d',[FixedIndepCode.Items.Strings[index],j+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + break; + end; + end; + end; + // Check for random effects variables next + if NRndIndep > 0 then + begin + for i := 0 to NRndIndep-1 do + begin + if cellstring = RndIndepCode.Items.Strings[i] then + begin + index := i; + for j := 0 to NRndVecIndep[index]-1 do + begin + ColSelected[NEntered] := RndIndepPos[index] + j; + labelstr := format('%s_%d',[RndIndepCode.Items.Strings[index],j+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + break; + end; + end; + end; + // check for interactions next + if NoInterDefs > 0 then + begin + for i := 0 to NoInterDefs-1 do + begin + if cellstring = InteractList.Items.Strings[i] then + begin + for j := 0 to NInteractVecs[i]-1 do + begin + ColSelected[NEntered] := InteractPos[i] + j; + labelstr := format('%s%d_%d',['IA',i+1,j+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + break; + end; + end; + end; // check for interaction variables + + // check for repeated measures variables (person codes) + if NReptDep > 0 then + begin // look for 'IP' in cellstring + labelstr := copy(cellstring,0,2); + if labelstr = 'IP' then // person vectors were generated + begin + for i := 0 to NoCases - 2 do + begin + ColSelected[NEntered] := ReptIndepPos[i]; + Labels[NEntered] := GenLabels[ReptIndepPos[i]]; + NEntered := NEntered + 1; + end; + end; + end; + + // check for repeated treatments + if NReptDep > 0 then + begin // look for 'IR' in cellstring + labelstr := copy(cellstring,0,2); + if labelstr = 'IR' then // repeated treatment vectors were generated + begin + for i := 0 to NReptDep - 2 do + begin + ColSelected[NEntered] := ReptTrtPos[i]; + Labels[NEntered] := GenLabels[ReptTrtPos[i]]; + NEntered := NEntered + 1; + end; + end; + end; + + RegAnal(NEntered); + R := sqrt(R2); + df1 := Nentered - 1; // no. of independent variables + df2 := totalobs - df1 - 1; // N - no. independent - 1 + SSt := (totalobs-1) * Vars[0]; + SSres := SSt * (1.0 - R2); + VarEst := SSres / df2; + if (VarEst > 0.0) then StdErrEst := sqrt(VarEst) + else + begin + ShowMessage('ERROR! Error in computing variance estimate.'); + StdErrEst := 0.0; + end; + if (R2 < 1.0) and (df2 > 0.0) then F := (R2 / df1) / ((1.0-R2)/ df2) + else F := 0.0; + FProbF := probf(F,df1,df2); + AdjR2 := 1.0 - (1.0 - R2) * (totalobs - 1) / df2; +// OutputFrm.RichEdit.ParaGraph.Alignment := taLeftJustify; + outline := format('%8s%10s%10s%12s%5s%5s',['R','R2','F','Prob.>F','DF1','DF2']); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('%8.3f%10.3f%10.3f%10.3f%5.0f%5.0f', + [R,R2,F,FProbF,df1,df2]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Adjusted R Squared = %5.3f',[AdjR2]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Std. Error of Estimate = %10.3f',[StdErrEst]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Variable Beta B Std.Error t Prob.>t'); + df1 := 1.0; + sum := 0.0; + for i := 0 to Nentered - 2 do + begin + SSx := (totalobs-1) * Vars[i+1]; + sum := sum + B[i] * means[i+1]; + if invmatrix[i,i] > 1.0e-15 then + begin + StdErrB := VarEst / (SSx * (1.0 / invmatrix[i,i])); + StdErrB := sqrt(StdErrB); + if StdErrB > 0.0 then F := B[i] / StdErrB else F := 0.0; + FProbF := probf(F*F,df1,df2); + end + else begin + StdErrB := 0.0; + F := 0.0; + FProbF := 0.0; + end; + cellstring := format('%10s',[Labels[i+1]]); + outline := format('%10s%10.3f%10.3f%10.3f%10.3f%10.3f', + [cellstring, Beta[i] ,B[i], StdErrB, F, FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + constant := means[0] - sum; + outline := format('Constant = %10.3f',[constant]); + OutputFrm.RichEdit.Lines.Add(outline); + + // test increment in R2 for this block + R2Increment := R2 - OldR2; + if priorentered > 0 then + df1 := (NEntered-1) - (priorentered-1) + else df1 := NEntered - 1; + df2 := totalobs - NEntered; + TypeIDF1[block] := df1; + TypeIDF2[block] := df2; + TypeISS[block] := (R2 - OldR2) * SSt; + TypeIMS[block] := TypeISS[block] / df1; + F := ((R2 - OldR2)/ df1) / ((1.0 - R2) / df2); + TypeIF[block] := F; + FProbF := probf(F,df1,df2); + TypeIProb[block] := FProbF; + outline := format('Increment in Squared R = %10.3f',[R2Increment]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('F with degrees freedom %4.0f and %4.0f = %10.3f, Prob.>F = %10.3f', + [df1,df2,F,FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + OldR2 := R2; + priorentered := NEntered; + // setup for next block analysis + WorkMat := nil; + StdDevs := nil; + Vars := nil; + means := nil; + Beta := nil; + B := nil; + invmatrix := nil; + rxy := nil; + indmatrix := nil; + rmatrix := nil; + end; // next variable block + + // Next, obtain the unique (Type II values) by elimination of each block + // from the full model and testing the decrement in R2 + FullR2 := R2; // save previously obtained full model R2 + for i := 0 to NoBlocks - 1 do + begin + NEntered := 0; + // enter the dependent variable first + if NContDep > 0 then + begin + ColSelected[0] := ContDepPos[0]; + Labels[0] := GenLabels[1]; + end + else begin + ColSelected[0] := ReptDepPos[0]; + Labels[0] := GenLabels[1]; + end; + NEntered := NEntered + 1; + for block := 0 to NoBlocks - 1 do + begin + if i = block then continue // delete this block + else + begin // enter the remaining blocks + cellstring := IndOrderBox.Items.Strings[block]; + // if a covariate, include it + if NCovIndep > 0 then + begin + for j := 0 to NCovIndep-1 do + begin + if cellstring = CovariateCode.Items.Strings[j] then // matched! + begin + index := j; // index of covariate code + ColSelected[NEntered] := CovIndepPos[index]; + labelstr := format('%s',[CovariateCode.Items.Strings[index]]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + break; + end; + end; + end; + // check for fixed effect variables next + if NFixedIndep > 0 then + begin + for j := 0 to NFixedIndep-1 do + begin + if cellstring = FixedIndepCode.Items.Strings[j] then + begin + index := j; + for k := 0 to NFixVecIndep[index]-1 do + begin + ColSelected[NEntered] := FixedIndepPos[index] + k; + labelstr := format('%s_%d',[FixedIndepCode.Items.Strings[index],k+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + break; + end; + end; + end; + // Check for random effects variables next + if NRndIndep > 0 then + begin + for j := 0 to NRndIndep-1 do + begin + if cellstring = RndIndepCode.Items.Strings[j] then + begin + index := j; + for k := 0 to NRndVecIndep[index]-1 do + begin + ColSelected[NEntered] := RndIndepPos[index] + k; + labelstr := format('%s_%d',[RndIndepCode.Items.Strings[index],k+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + end; + break; + end; + end; + // check for interactions next + if NoInterDefs > 0 then + begin + for j := 0 to NoInterDefs-1 do + begin + if cellstring = InteractList.Items.Strings[j] then + begin + for k := 0 to NInteractVecs[j]-1 do + begin + ColSelected[NEntered] := InteractPos[j] + k; + labelstr := format('%s%d_%d',['IA',j+1,k+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + break; + end; // end if + end; // next j + end; // end if interdefs > 0 + end; // entry of remaining blocks + end; // enter next block not equal to block i + + RegAnal(NEntered); // compute restricted model + if R2 > 0.0 then R := sqrt(R2) else R := 0.0; + df1 := Nentered; // no. of independent variables + df2 := totalobs - df1 - 1; // N - no. independent - 1 + SSt := (totalobs-1) * Vars[0]; + SSres := SSt * (1.0 - R2); + VarEst := SSres / df2; + if (VarEst > 0.0) then StdErrEst := sqrt(VarEst) + else + begin + ShowMessage('ERROR! Error in computing variance estimate.'); + StdErrEst := 0.0; + end; + if (R2 < 1.0) and (df2 > 0.0) then F := (R2 / df1) / ((1.0-R2)/ df2) + else F := 0.0; + FProbF := probf(F,df1,df2); + AdjR2 := 1.0 - (1.0 - R2) * (totalobs - 1) / df2; +// OutputFrm.RichEdit.ParaGraph.Alignment := taLeftJustify; + outline := format('%8s%10s%10s%12s%5s%5s',['R','R2','F','Prob.>F','DF1','DF2']); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('%8.3f%10.3f%10.3f%10.3f%5.0f%5.0f', + [R,R2,F,FProbF,df1,df2]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Adjusted R Squared = %5.3f',[AdjR2]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Std. Error of Estimate = %10.3f',[StdErrEst]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Variable Beta B Std.Error t Prob.>t'); + df1 := 1.0; + sum := 0.0; + for j := 0 to Nentered - 2 do + begin + SSx := (totalobs-1) * Vars[j+1]; + sum := sum + B[j] * means[j+1]; + if invmatrix[j,j] > 1.0e-18 then + StdErrB := VarEst / (SSx * (1.0 / invmatrix[j,j])) + else StdErrB := 0.0; + if StdErrB > 0.0 then StdErrB := sqrt(StdErrB); + if StdErrB > 0.0 then F := B[j] / StdErrB else F := 0.0; + FProbF := probf(F*F,df1,df2); + cellstring := format('%10s',[Labels[j+1]]); + outline := format('%10s%10.3f%10.3f%10.3f%10.3f%10.3f', + [cellstring, Beta[j] ,B[j], StdErrB, F, FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + constant := means[0] - sum; + outline := format('Constant = %10.3f',[constant]); + OutputFrm.RichEdit.Lines.Add(outline); + + // Now compute unique contribution of block left out (Type II) + R2Increment := FullR2 - R2; + df1 := (novars - 2) - (NEntered - 1); // k1 - k2 + df2 := totalobs - (novars - 2) - 1; + TypeIIDF1[i] := df1; + TypeIIDF2[i] := df2; + TypeIISS[i] := (FullR2 - R2) * SSt; + TypeIIMS[i] := TypeIISS[i] / df1; + F := ((FullR2 - R2)/ df1) / ((1.0 - FullR2) / df2); + TypeIIF[i] := F; + FProbF := probf(F,df1,df2); + TypeIIProb[i] := FProbF; + outline := format('Decrement in Squared R = %10.3f',[R2Increment]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('F with degrees freedom %4.0f and %4.0f = %10.3f, Prob.>F = %10.3f', + [df1,df2,F,FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + // setup for next block analysis + WorkMat := nil; + StdDevs := nil; + Vars := nil; + means := nil; + Beta := nil; + B := nil; + invmatrix := nil; + rxy := nil; + indmatrix := nil; + rmatrix := nil; + end; // next i block selected for elimination + + // Show summary table of Type I and Type II tests + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Summary Table for GLM Effects'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Incremental Effects.'); + OutputFrm.RichEdit.Lines.Add('SOURCE DF1 DF2 SS MS F PROB>F'); + for i := 0 to NoBlocks - 1 do + begin + cellstring := IndOrderBox.Items.Strings[i]; + outline := format('%10s %3.0f %3.0f %10.3f %10.3f %10.3f %6.3f', + [cellstring,TypeIDF1[i],TypeIDF2[i],TypeISS[i],TypeIMS[i],TypeIF[i],TypeIProb[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Unique Effects.'); + OutputFrm.RichEdit.Lines.Add('SOURCE DF1 DF2 SS MS F PROB>F'); + for i := 0 to NoBlocks - 1 do + begin + cellstring := IndOrderBox.Items.Strings[i]; + outline := format('%10s %3.0f %3.0f %10.3f %10.3f %10.3f %6.3f', + [cellstring,TypeIIDF1[i],TypeIIDF2[i],TypeIISS[i],TypeIIMS[i],TypeIIF[i],TypeIIProb[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; + + // Show Anova Results for fixed and/or covariates + OutputFrm.RichEdit.Clear; + if (NRndIndep = 0) and (NReptDep = 0) then // must be fixed and/or covariate only design + begin + if (NFixedIndep > 0) or (NCovIndep > 0) then // fixed effects + begin + df1 := novars - 2; // k1 (note: novars contains ID variable, dep, independents) + PredSS := SSt * FullR2; + PredMS := PredSS / df1; + df2 := totalobs - df1 - 1; // residual df + SSres := SSt * (1.0 - FullR2); + VarEst := SSres / df2; // ms residual + F := PredMS / VarEst; + FProbF := probf(F,df1,df2); + OutputFrm.RichEdit.Lines.Add('SOURCE DF SS MS F PROB>F'); + outline := format('%20s %3.0f %10.3f %10.3f %10.3f %6.3f', + ['Full Model',df1,PredSS,PredMS,F,FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + for i := 0 to NoBlocks - 1 do + begin + F := TypeIMS[i] / VarEst; + FProbF := probf(F,TypeIDF1[i],df2); + cellstring := IndOrderBox.Items.Strings[i]; + outline := format('%20s %3.0f %10.3f %10.3f %10.3f %6.3f', + [cellstring,TypeIDF1[i],TypeISS[i],TypeIMS[i],F,FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := format('%20s %3.0f %10.3f %10.3f', + ['Residual',df2,SSres,VarEst]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('%20s %3d %10.3f', + ['Total',totalobs-1,SSt]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + end; + end; + + // Show Anova Results for random effects and/or covariates + OutputFrm.RichEdit.Clear; + if (NFixedIndep = 0) and (NReptDep = 0) then // must be random only or covariate only design + begin + if (NRndIndep > 0) or (NCovIndep > 0) then // random and/or covariate effects + begin + df1 := novars - 2; // k1 (note: novars contains ID variable, dep, independents) + PredSS := SSt * FullR2; + PredMS := PredSS / df1; + df2 := totalobs - df1 - 1; // residual df + SSres := SSt * (1.0 - FullR2); + VarEst := SSres / df2; // ms residual + F := PredMS / VarEst; + FProbF := probf(F,df1,df2); + OutputFrm.RichEdit.Lines.Add('SOURCE DF SS MS F PROB>F'); + outline := format('%20s %3.0f %10.3f %10.3f %10.3f %6.3f', + ['Full Model',df1,PredSS,PredMS,F,FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + for i := 0 to NoBlocks - 1 do + begin + F := TypeIMS[i] / VarEst; + FProbF := probf(F,TypeIDF1[i],df2); + outline := format('%20s %3.0f %10.3f %10.3f %10.3f %6.3f', + [Labels[i+1],TypeIDF1[i],TypeISS[i],TypeIMS[i],F,FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := format('%20s %3.0f %10.3f %10.3f', + ['Residual',df2,SSres,VarEst]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('%20s %3d %10.3f', + ['Total',totalobs-1,SSt]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + end; + end; + + // show effects for repeated measures ANOVA (and covariates) + OutputFrm.RichEdit.Clear; + if NReptDep > 0 then + begin + df1 := novars - 2; // k1 (note: novars contains ID variable, dep, independents) + PredSS := SSt * FullR2; + PredMS := PredSS / df1; + df2 := totalobs - df1 - 1; // residual df + SSres := SSt * (1.0 - FullR2); + VarEst := SSres / df2; // ms residual + F := PredMS / VarEst; + FProbF := probf(F,df1,df2); + OutputFrm.RichEdit.Lines.Add('SOURCE DF SS MS F PROB>F'); + outline := format('%20s %3.0f %10.3f %10.3f %10.3f %6.3f', + ['Full Model',df1,PredSS,PredMS,F,FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + for i := 0 to NoBlocks - 1 do + begin + F := TypeIMS[i] / VarEst; + FProbF := probf(F,TypeIDF1[i],df2); + outline := format('%20s %3.0f %10.3f %10.3f %10.3f %6.3f', + [Labels[i+1],TypeIDF1[i],TypeISS[i],TypeIMS[i],F,FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := format('%20s %3.0f %10.3f %10.3f', + ['Residual',df2,SSres,VarEst]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('%20s %3d %10.3f', + ['Total',totalobs-1,SSt]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + end; + + // clean up the heap + TypeIIProb := nil; + TypeIIF := nil; + TypeIProb := nil; + TypeIF := nil; + TypeIIDF2 := nil; + TypeIIDF1 := nil; + TypeIDF2 := nil; + TypeIDF1 := nil; + TypeIIMS := nil; + TypeIMS := nil; + TypeIISS := nil; + TypeISS := nil; +end; + +procedure TGLMFrm.ModelIIAnalysis; +var + block, i, j, NEntered, index, noblocks : integer; + NLeft, NRight : integer; + cellstring : string; + labelstr : string; + +begin + NEntered := 0; + OldR2 := 0; + // enter the dependent variables first + if NContDep > 0 then + begin + for i := 0 to NContDep - 1 do + begin + ColSelected[i] := ContDepPos[i]; + Labels[i] := GenLabels[i+1]; + NEntered := NEntered + 1; + end; + end; + if NReptDep > 0 then + begin + for i := 0 to NReptDep - 1 do + begin + ColSelected[NEntered+i] := ReptDepPos[i]; + Labels[NEntered+i] := GenLabels[NEntered+i+1]; + NEntered := NEntered + 1; + end; + end; + if NCatDep > 0 then + begin + for i := 0 to NCatDep - 1 do + begin + for j := 0 to NFixVecDep[i]-1 do + begin + ColSelected[NEntered+j] := CatDepPos[j]; + Labels[NEntered+j] := GenLabels[NEntered+j+1]; + NEntered := NEntered + 1; + end; + end; + end; + + // Enter the no. of dependent variables in the left list box of canonical + NLeft := NEntered; + + // Enter independent variables as indicated in indorderbox then interactions + // until the total model is analyzed. Then delete each term to get a + // restricted model and compare to the full model. + noblocks := IndOrderBox.Items.Count; + SetLength(TypeISS,noblocks); + SetLength(TypeIISS,noblocks); + SetLength(TypeIMS,noblocks); + SetLength(TypeIIMS,noblocks); + SetLength(TypeIDF1,noblocks); + SetLength(TypeIDF2,noblocks); + SetLength(TypeIIDF1,noblocks); + SetLength(TypeIIDF2,noblocks); + SetLength(TypeIF,noblocks); + SetLength(TypeIProb,noblocks); + SetLength(TypeIIF,noblocks); + SetLength(TypeIIProb,noblocks); + + for block := 0 to noblocks - 1 do + begin + // get index of the abbreviation of term to enter and find corresponding + // vector(s) to place in the equation + cellstring := IndOrderBox.Items.Strings[block]; + // check for covariates first + if NCovIndep > 0 then + begin + for i := 0 to NCovIndep-1 do + begin + if cellstring = CovariateCode.Items.Strings[i] then // matched! + begin + index := i; // index of covariate code + ColSelected[NEntered] := CovIndepPos[index]; + labelstr := format('%s',[CovariateCode.Items.Strings[index]]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + break; + end; + end; + end; + // check for fixed effect variables next + if NFixedIndep > 0 then + begin + for i := 0 to NFixedIndep-1 do + begin + if cellstring = FixedIndepCode.Items.Strings[i] then + begin + index := i; + for j := 0 to NFixVecIndep[index]-1 do + begin + ColSelected[NEntered] := FixedIndepPos[index] + j; + labelstr := format('%s_%d',[FixedIndepCode.Items.Strings[index],j+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + break; + end; + end; + end; + // Check for random effects variables next + if NRndIndep > 0 then + begin + for i := 0 to NRndIndep-1 do + begin + if cellstring = RndIndepCode.Items.Strings[i] then + begin + index := i; + for j := 0 to NRndVecIndep[index]-1 do + begin + ColSelected[NEntered] := RndIndepPos[index] + j; + labelstr := format('%s_%d',[RndIndepCode.Items.Strings[index],j+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + end; + break; + end; + end; + // check for interactions next + if NoInterDefs > 0 then + begin + for i := 0 to NoInterDefs-1 do + begin + if cellstring = InteractList.Items.Strings[i] then + begin + for j := 0 to NInteractVecs[i]-1 do + begin + ColSelected[NEntered] := InteractPos[i] + j; + labelstr := format('%s%d_%d',['IA',i+1,j+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + end; + break; + end; + end; // check for interaction variables + + // check for repeated measures variables (person codes) + if NReptDep > 0 then + begin // look for 'IP' in cellstring + labelstr := copy(cellstring,0,2); + if labelstr = 'IP' then // person vectors were generated + begin + for i := 0 to NoCases - 2 do + begin + ColSelected[NEntered] := ReptIndepPos[i]; + Labels[NEntered] := GenLabels[ReptIndepPos[i]]; + NEntered := NEntered + 1; + end; + end; + end; + + // Enter the independent variables in the right list of canonical. + NRight := NEntered - NLeft; + + // call cancor routine for this block + cancor(NLeft,NRight,ColSelected); + end; // next block + + TypeIIProb := nil; + TypeIIF := nil; + TypeIProb := nil; + TypeIIDF2 := nil; + TypeIIDF1 := nil; + TypeIDF2 := nil; + TypeIDF1 := nil; + TypeIIMS := nil; + TYPEIMS := nil; + TypeIISS := nil; + TypeISS := nil; +end; + +procedure TGLMFrm.ModelIIIAnalysis; +var + block, i, j, NEntered, index, noblocks, priorentered : integer; + cellstring : string; + labelstr : string; + outline, effstr : string; + R, SSx, sum, constant: double; + df1, df2, F, FProbF, StdErrB, OldDF1: double; + SSt, VarEst, SSres, StdErrEst, AdjR2 : double; + dfbetween, dferrbetween, dfwithin, dferrwithin : double; + ssbetween, sserrbetween, mserrbetween, sswithin, sserrwithin, mserrwithin : double; + betweenblock : integer; + totalss, totaldf : double; + +begin + OldDF1 := 0.0; + priorentered := 0; + OldR2 := 0; + ColSelected[0] := ReptDepPos[0]; + Labels[0] := GenLabels[1]; + // Complete an individual regression analysis for each between subjects var. + // Enter each block containing between subjects variance including: + // (1) covariates + // (2) person vectors + // (3) fixed or random factors + // (4) the interactions among only fixed or random effects + noblocks := IndOrderBox.Items.Count; + SetLength(TypeISS,noblocks); // use for between subject effects + SetLength(TypeIISS,noblocks);// use for within subject effects + SetLength(TypeIMS,noblocks); + SetLength(TypeIIMS,noblocks); + SetLength(TypeIDF1,noblocks); + SetLength(TypeIDF2,noblocks); + SetLength(TypeIIDF1,noblocks); + SetLength(TypeIIDF2,noblocks); + SetLength(TypeIF,noblocks); + SetLength(TypeIProb,noblocks); + SetLength(TypeIIF,noblocks); + SetLength(TypeIIProb,noblocks); + + for i := 0 to noblocks - 1 do + begin + TypeISS[i] := -1.0; // store indicator for block (-1 indicates no use) + TypeIISS[i] := -1.0; + end; + + for block := 0 to noblocks - 1 do + begin + ColSelected[0] := ReptDepPos[0]; + Labels[0] := GenLabels[1]; + NEntered := 1; + cellstring := IndOrderBox.Items.Strings[block]; + effstr := cellstring; + j := Pos('IR',cellstring); + if j <> 0 then continue; + // check for repeated measures variables (person codes) + if NReptDep > 0 then + begin // look for 'IP' in cellstring + labelstr := copy(cellstring,0,2); + if labelstr = 'IP' then // person vectors were generated + begin + betweenblock := block; // save block no. of between subject vectors + for i := 0 to NoCases - 2 do + begin + ColSelected[NEntered] := ReptIndepPos[i]; + Labels[NEntered] := GenLabels[ReptIndepPos[i]]; + NEntered := NEntered + 1; + end; + end; + end; + // check for fixed effect variables next + if NFixedIndep > 0 then + begin + for i := 0 to NFixedIndep-1 do + begin + if cellstring = FixedIndepCode.Items.Strings[i] then + begin + index := i; + for j := 0 to NFixVecIndep[index]-1 do + begin + ColSelected[NEntered] := FixedIndepPos[index] + j; + labelstr := format('%s_%d',[FixedIndepCode.Items.Strings[index],j+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + break; + end; + end; + end; + // Check for random effects variables next + if NRndIndep > 0 then + begin + for i := 0 to NRndIndep-1 do + begin + if cellstring = RndIndepCode.Items.Strings[i] then + begin + index := i; + for j := 0 to NRndVecIndep[index]-1 do + begin + ColSelected[NEntered] := RndIndepPos[index] + j; + labelstr := format('%s_%d',[RndIndepCode.Items.Strings[index],j+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + break; + end; + end; + end; + // check for interactions next + if NoInterDefs > 0 then + begin + for i := 0 to NoInterDefs-1 do + begin + if cellstring = InteractList.Items.Strings[i] then + begin + // eliminate any interactions containing 'IR' + j := Pos('IR',cellstring); + if j <> 0 then continue; + for j := 0 to NInteractVecs[i]-1 do + begin + ColSelected[NEntered] := InteractPos[i] + j; + labelstr := format('%s%d_%d',['IA',i+1,j+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + break; + end; + end; + end; // check for interaction variables + // check for covariates + if NCovIndep > 0 then + begin + for i := 0 to NCovIndep-1 do + begin + if cellstring = CovariateCode.Items.Strings[i] then // matched! + begin + index := i; // index of covariate code + ColSelected[NEntered] := CovIndepPos[index]; + labelstr := format('%s',[CovariateCode.Items.Strings[index]]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + break; + end; + end; + end; + + // do reg analysis and save sum of squares + RegAnal(NEntered); + R := sqrt(R2); + df1 := Nentered - 1; // no. of independent variables + TypeIDF1[block] := df1; + df2 := totalobs - df1 - 1; // N - no. independent - 1 + SSt := (totalobs-1) * Vars[0]; + SSres := SSt * (1.0 - R2); + VarEst := SSres / df2; + if (VarEst > 0.0) then StdErrEst := sqrt(VarEst) + else + begin + ShowMessage('ERROR! Error in computing variance estimate.'); + StdErrEst := 0.0; + end; + if (R2 < 1.0) and (df2 > 0.0) then F := (R2 / df1) / ((1.0-R2)/ df2) + else F := 0.0; + FProbF := probf(F,df1,df2); + AdjR2 := 1.0 - (1.0 - R2) * (totalobs - 1) / df2; +// OutputFrm.RichEdit.ParaGraph.Alignment := taLeftJustify; + outline := format('%8s%10s%10s%12s%5s%5s',['R','R2','F','Prob.>F','DF1','DF2']); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('%8.3f%10.3f%10.3f%10.3f%5.0f%5.0f', + [R,R2,F,FProbF,df1,df2]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Adjusted R Squared = %5.3f',[AdjR2]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Std. Error of Estimate = %10.3f',[StdErrEst]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Variable Beta B Std.Error t Prob.>t'); + df1 := 1.0; + sum := 0.0; + for i := 0 to Nentered - 2 do + begin + SSx := (totalobs-1) * Vars[i+1]; + sum := sum + B[i] * means[i+1]; + if invmatrix[i,i] > 1.0e-15 then + begin + StdErrB := VarEst / (SSx * (1.0 / invmatrix[i,i])); + StdErrB := sqrt(StdErrB); + if StdErrB > 0.0 then F := B[i] / StdErrB else F := 0.0; + FProbF := probf(F*F,df1,df2); + end + else begin + StdErrB := 0.0; + F := 0.0; + FProbF := 0.0; + end; + cellstring := format('%10s',[Labels[i+1]]); + outline := format('%10s%10.3f%10.3f%10.3f%10.3f%10.3f', + [cellstring, Beta[i] ,B[i], StdErrB, F, FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + constant := means[0] - sum; + outline := format('Constant = %10.3f',[constant]); + OutputFrm.RichEdit.Lines.Add(outline); + TypeISS[block] := R2 * SST; + OutputFrm.RichEdit.Lines.Add('BETWEEN SUBJECT EFFECT:'); + outline := format('SS for %-10s = %10.3f',[effstr,TypeISS[block]]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('SS TOTAL = %10.3f',[SST]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + end; + + // Summarize between subject effects + totalss := 0.0; + totaldf := 0.0; + for i := 0 to noblocks - 1 do + begin + if TypeISS[i] < 0.0 then continue; + if betweenblock = i then + begin + ssbetween := TypeISS[i]; + dfbetween := TypeIDF1[i]; + end + else + begin + totalss := totalss + TypeISS[i]; + totaldf := totaldf + TypeIDF1[i]; + end; + end; + sserrbetween := ssbetween - totalss; + dferrbetween := dfbetween - totaldf; + mserrbetween := sserrbetween / dferrbetween; + + OutputFrm.RichEdit.Lines.Clear; + OutputFrm.RichEdit.Lines.Add(' SUMMARY OF BETWEEN SUBJECT EFFECTS'); + outline := 'SOURCE DF SS MS F PROB.>F'; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('%-19s %3.0f %9.3f',['Between Subjects',dfbetween, ssbetween]); + OutputFrm.RichEdit.Lines.Add(outline); + for i := 0 to noblocks - 1 do + begin + if TypeISS[i] < 0.0 then continue; + if betweenblock = i then continue; // already done above + TypeIMS[i] := TypeISS[i] / TypeIDF1[i]; + TypeIF[i] := TypeIMS[i] / mserrbetween; + TypeIDF2[i] := dferrbetween; + TypeIProb[i] := probf(TypeIF[i],TypeIDF1[i],TypeIDF2[i]); + outline := format('%19s %3.0f %9.3f %9.3f %9.3f %9.3f', + [IndOrderBox.Items.Strings[i],TypeIDF1[i],TypeISS[i],TypeIMS[i], + TypeIF[i],TypeIProb[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := format('%19s %3.0f %9.3f %9.3f',['Error Between', dferrbetween, + sserrbetween, mserrbetween]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + + // Now, get within subject effects + sswithin := SST - SSbetween; + dfwithin := totalobs - dfbetween - 1; + for block := 0 to noblocks - 1 do + begin + ColSelected[0] := ReptDepPos[0]; + Labels[0] := GenLabels[1]; + NEntered := 1; + cellstring := IndOrderBox.Items.Strings[block]; + effstr := cellstring; + j := Pos('IR',cellstring); + if j = 0 then continue; // only select those for rep. treatments or interactions + + // check for treatments + if NReptDep > 0 then + begin // look for 'IR' in cellstring + labelstr := copy(cellstring,0,2); + if labelstr = 'IR' then // repeated treatment vectors were generated + begin + for i := 0 to NReptDep - 2 do + begin + ColSelected[NEntered] := ReptTrtPos[i]; + Labels[NEntered] := GenLabels[ReptTrtPos[i]]; + NEntered := NEntered + 1; + end; + end; + end; + // check for interactions next + if NoInterDefs > 0 then + begin + for i := 0 to NoInterDefs-1 do + begin + if cellstring = InteractList.Items.Strings[i] then + begin + for j := 0 to NInteractVecs[i]-1 do + begin + ColSelected[NEntered] := InteractPos[i] + j; + labelstr := format('%s%d_%d',['IA',i+1,j+1]); + Labels[NEntered] := labelstr; + NEntered := NEntered + 1; + end; + break; + end; + end; + end; // check for interaction variables + // do reg analysis and save sum of squares + if NEntered < 2 then continue; + RegAnal(NEntered); + R := sqrt(R2); + df1 := Nentered - 1; // no. of independent variables + TypeIIDF1[block] := df1; + df2 := totalobs - df1 - 1; // N - no. independent - 1 + SSt := (totalobs-1) * Vars[0]; + SSres := SSt * (1.0 - R2); + VarEst := SSres / df2; + if (VarEst > 0.0) then StdErrEst := sqrt(VarEst) + else + begin + ShowMessage('ERROR! Error in computing variance estimate.'); + StdErrEst := 0.0; + end; + if (R2 < 1.0) and (df2 > 0.0) then F := (R2 / df1) / ((1.0-R2)/ df2) + else F := 0.0; + FProbF := probf(F,df1,df2); + AdjR2 := 1.0 - (1.0 - R2) * (totalobs - 1) / df2; +// OutputFrm.RichEdit.ParaGraph.Alignment := taLeftJustify; + outline := format('%8s%10s%10s%12s%5s%5s',['R','R2','F','Prob.>F','DF1','DF2']); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('%8.3f%10.3f%10.3f%10.3f%5.0f%5.0f', + [R,R2,F,FProbF,df1,df2]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Adjusted R Squared = %5.3f',[AdjR2]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Std. Error of Estimate = %10.3f',[StdErrEst]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Variable Beta B Std.Error t Prob.>t'); + df1 := 1.0; + sum := 0.0; + for i := 0 to Nentered - 2 do + begin + SSx := (totalobs-1) * Vars[i+1]; + sum := sum + B[i] * means[i+1]; + if invmatrix[i,i] > 1.0e-15 then + begin + StdErrB := VarEst / (SSx * (1.0 / invmatrix[i,i])); + StdErrB := sqrt(StdErrB); + if StdErrB > 0.0 then F := B[i] / StdErrB else F := 0.0; + FProbF := probf(F*F,df1,df2); + end + else begin + StdErrB := 0.0; + F := 0.0; + FProbF := 0.0; + end; + cellstring := format('%10s',[Labels[i+1]]); + outline := format('%10s%10.3f%10.3f%10.3f%10.3f%10.3f', + [cellstring, Beta[i] ,B[i], StdErrB, F, FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + constant := means[0] - sum; + outline := format('Constant = %10.3f',[constant]); + OutputFrm.RichEdit.Lines.Add(outline); + TypeIISS[block] := R2 * SST; + OutputFrm.RichEdit.Lines.Add('WITHIN SUBJECT EFFECT:'); + outline := format('SS for %-10s = %10.3f',[effstr,TypeIISS[block]]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('SS TOTAL = %10.3f',[SST]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + end; + totalss := 0.0; + totaldf := 0.0; + for i := 0 to noblocks - 1 do // add sums of squares for within effects + begin + if TypeIISS[i] < 0.0 then continue; + totalss := totalss + TypeIISS[i]; + totaldf := totaldf + TypeIIDF1[i]; + end; + sserrwithin := sswithin - totalss; + dferrwithin := dfwithin - totaldf; + mserrwithin := sserrwithin / dferrwithin; + + OutputFrm.RichEdit.Lines.Clear; + OutputFrm.RichEdit.Lines.Add(' SUMMARY OF WITHIN SUBJECT EFFECTS'); + outline := 'SOURCE DF SS MS F PROB.>F'; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('%-19s %3.0f %9.3f',['Within Subjects',dfwithin, sswithin]); + OutputFrm.RichEdit.Lines.Add(outline); + for i := 0 to noblocks - 1 do + begin + if TypeIISS[i] < 0.0 then continue; + TypeIIMS[i] := TypeIISS[i] / TypeIIDF1[i]; + TypeIIF[i] := TypeIIMS[i] / mserrwithin; + TypeIIDF2[i] := dferrwithin; + TypeIIProb[i] := probf(TypeIIF[i],TypeIIDF1[i],TypeIIDF2[i]); + outline := format('%19s %3.0f %9.3f %9.3f %9.3f %9.3f', + [IndOrderBox.Items.Strings[i],TypeIIDF1[i],TypeIISS[i],TypeIIMS[i], + TypeIIF[i],TypeIIProb[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := format('%19s %3.0f %9.3f %9.3f',['Error Within', dferrwithin, + sserrwithin, mserrwithin]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('%19s %3d %9.3f',['TOTAL',totalobs-1,SST]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + + // clean up the heap + TypeIIProb := nil; + TypeIIF := nil; + TypeIProb := nil; + TypeIF := nil; + TypeIIDF2 := nil; + TypeIIDF1 := nil; + TypeIDF2 := nil; + TypeIDF1 := nil; + TypeIIMS := nil; + TypeIMS := nil; + TypeIISS := nil; + TypeISS := nil; +end; + +function TGLMFrm.CntIntActVecs(linestr: string): integer; +var + i, j, listcnt, varcount : integer; + cellstring : string; + asterisk : string; + blank : string; + abbrevList : array[1..5] of string; + vectcnt : array[1..5] of integer; + newline : string; + +begin + asterisk := '*'; + blank := ' '; + listcnt := 0; + cellstring := ''; + newline := ''; + for i := 1 to 5 do vectcnt[i] := 0; + // first, delete imbedded blanks that were there for readability + for i := 1 to length(linestr) do + begin + if linestr[i] <> blank then newline := newline + linestr[i]; + end; + // Now, strip out substrings to each asterisk or end of string + while length(newline) > 0 do + begin + i := pos(asterisk,newline); + if i > 0 then // an asterisk found + begin + cellstring := copy(newline,0,i-1); // get abbreviation + delete(newline,1,i); // delete abbreviation and asterisk + listcnt := listcnt + 1; + AbbrevList[listcnt] := cellstring; + end + else begin // must be last abbreviation + cellstring := newline; + listcnt := listcnt + 1; + AbbrevList[listcnt] := cellstring; + newline := ''; + end; + end; + // now get the associated number of columns for each abbreviation in the list + for i := 1 to listcnt do + begin + cellstring := AbbrevList[i]; + // check for covariates + if NCovIndep > 0 then + begin + for j := 0 to NCovIndep - 1 do + begin + if cellstring = CovariateCode.Items.Strings[j] then + vectcnt[i] := 1; + end; + end; + // check for fixed effect vectors + if NFixedIndep > 0 then + begin + for j := 0 to NFixedIndep - 1 do + begin + if cellstring = FixedIndepCode.Items.Strings[j] then + vectcnt[i] := NFixVecIndep[j]; + end; + end; + // check for random effect vectors + if NRndIndep > 0 then + begin + for j := 0 to NRndIndep - 1 do + begin + if cellstring = RndIndepCode.Items.Strings[j] then + vectcnt[i] := NRndVecIndep[j]; + end; + end; + // check for repeated measures effect vectors + if NReptDep > 0 then + begin + if cellstring = RepTrtCode.Items.Strings[0] then + vectcnt[i] := NReptDep - 1; + end; + end; // next i in listcnt + // get total interaction vector count + varcount := 1; + for i := 1 to listcnt do varcount := varcount * vectcnt[i]; + Result := varcount; +end; + +procedure TGLMFrm.GenInterVecs(linestr: string); +var + i, j, k, l, m, n, col, listcnt, pos1, pos2, pos3, pos4, pos5: integer; + cellstring : string; + asterisk : string; + blank : string; + abbrevList : array[1..5] of string; + vectcnt : array[1..5] of integer; + fromcol : array[1..5] of integer; + newline : string; + +begin + asterisk := '*'; + blank := ' '; + listcnt := 0; + cellstring := ''; + newline := ''; + // first, delete imbedded blanks that were there for readability + for i := 1 to length(linestr) do + begin + if linestr[i] <> blank then newline := newline + linestr[i]; + end; + // Now, strip out substrings to each asterisk or end of string + while length(newline) > 0 do + begin + i := pos(asterisk,newline); + if i > 0 then // an asterisk found + begin + cellstring := copy(newline,0,i-1); // get abbreviation + delete(newline,1,i); // delete abbreviation and asterisk + listcnt := listcnt + 1; + AbbrevList[listcnt] := cellstring; + end + else begin // must be last abbreviation + cellstring := newline; + listcnt := listcnt + 1; + AbbrevList[listcnt] := cellstring; + newline := ''; + end; + end; + // now generate the associated number of columns for each abbreviation in the list + for i := 1 to listcnt do + begin + cellstring := AbbrevList[i]; + // check for covariates + if NCovIndep > 0 then + begin + for j := 0 to NCovIndep - 1 do + begin + if cellstring = CovariateCode.Items.Strings[j] then + begin + vectcnt[i] := 1; + fromcol[i] := CovIndepPos[j]; + break; + end; + end; + end; + // check for fixed effect vectors + if NFixedIndep > 0 then + begin + for j := 0 to NFixedIndep - 1 do + begin + if cellstring = FixedIndepCode.Items.Strings[j] then + begin + vectcnt[i] := NFixVecIndep[j]; + fromcol[i] := FixedIndepPos[j]; + break; + end; + end; + end; + // check for random effect vectors + if NRndIndep > 0 then + begin + for j := 0 to NRndIndep - 1 do + begin + if cellstring = RndIndepCode.Items.Strings[j] then + begin + vectcnt[i] := NRndVecIndep[j]; + fromcol[i] := RndIndepPos[j]; + break; + end; + end; + end; + // check for repeated measures + if NReptDep > 0 then + begin + if cellstring = RepTrtCode.Items.Strings[0] then + begin + vectcnt[i] := NReptDep - 1; + fromcol[i] := ReptTrtPos[0]; + end; + end; + end; // next i in listcnt + + // now generate the product vectors for 2-way interactions + col := gencount; + for i := 1 to vectcnt[1] do + begin + pos1 := fromcol[1] + i - 1; + for j := 1 to vectcnt[2] do + begin + pos2 := fromcol[2] + j - 1; + for m := 0 to totalobs - 1 do + datagrid[m,col] := datagrid[m,pos1] * datagrid[m,pos2]; + cellstring := format('%s_%d*%s_%d',[AbbrevList[1],i,AbbrevList[2],j]); + GenLabels[col] := cellstring; + col := col + 1; + end; + end; + + if listcnt = 3 then // Do 3-way interactions + begin + col := gencount; + for i := 1 to vectcnt[1] do + begin + pos1 := fromcol[1] + i - 1; + for j := 1 to vectcnt[2] do + begin + pos2 := fromcol[2] + j - 1; + for k := 1 to vectcnt[3] do + begin + pos3 := fromcol[3] + k - 1; + for m := 0 to totalobs - 1 do + datagrid[m,col] := datagrid[m,pos1] * datagrid[m,pos2] * datagrid[m,pos3]; + cellstring := format('%s*%s*%s',[GenLabels[pos1],GenLabels[pos2],GenLabels[pos3]]); + GenLabels[col] := cellstring; + col := col + 1; + end; // next k + end; // next j + end; // next i + end; // if listcnt = 3 + + if listcnt = 4 then // Do 4-way interactions + begin + col := gencount; + for i := 1 to vectcnt[1] do + begin + pos1 := fromcol[1] + i - 1; + for j := 1 to vectcnt[2] do + begin + pos2 := fromcol[2] + j - 1; + for k := 1 to vectcnt[3] do + begin + pos3 := fromcol[3] + k - 1; + for l := 1 to vectcnt[4] do + begin + pos4 := fromcol[4] + l - 1; + for m := 0 to totalobs - 1 do + datagrid[m,col] := datagrid[m,pos1] * + datagrid[m,pos2] * datagrid[m,pos3] * datagrid[m,pos4]; + cellstring := format('%s*%s*%s*%s',[GenLabels[pos1], + GenLabels[pos2],GenLabels[pos3],GenLabels[pos4]]); + GenLabels[col] := cellstring; + col := col + 1; + end; // next l + end; // next k + end; // next j + end; // next i + end; // if listcnt = 3 + + if listcnt = 5 then // Do 5-way interactions + begin + col := gencount; + for i := 1 to vectcnt[1] do + begin + pos1 := fromcol[1] + i - 1; + for j := 1 to vectcnt[2] do + begin + pos2 := fromcol[2] + j - 1; + for k := 1 to vectcnt[3] do + begin + pos3 := fromcol[3] + k - 1; + for l := 1 to vectcnt[4] do + begin + pos4 := fromcol[4] + l - 1; + for n := 1 to vectcnt[5] do + begin + pos5 := fromcol[5] + n - 1; + for m := 0 to totalobs - 1 do + datagrid[m,col] := datagrid[m,pos1] * + datagrid[m,pos2] * datagrid[m,pos3] * + datagrid[m,pos4] * datagrid[m,pos5]; + cellstring := format('%s*%s*%s*%s*%s',[GenLabels[pos1], + GenLabels[pos2],GenLabels[pos3],GenLabels[pos4], + GenLabels[pos5]]); + GenLabels[col] := cellstring; + col := col + 1; + end; // next n + end; // next l + end; // next k + end; // next j + end; // next i + end; // if listcnt = 3 +end; + +procedure TGLMFrm.CanCor(NLeft: integer; NRight: integer; GridPlace: IntDyneVec); +label cleanup; +var + i, j, k, count, a_size, b_size, no_factors, IER: integer; + outline: string; + s, m, n, df1, df2, q, w, pcnt_extracted, trace : double; + minroot, critical_prob, Lambda, Pillia : double; + chisqr, HLTrace, chiprob, ftestprob, Roys, f, Hroot : double; + raa, rbb, rab, rba, bigmat, prod, first_prod, second_prod : DblDyneMat; + char_equation, raainv, rbbinv, eigenvectors, norm_a, norm_b : DblDyneMat; + raw_a, raw_b, a_cors, b_cors, eigentrans, theta, tempmat : DblDyneMat; + mean, variance, stddev, roots, root_chi, chi_prob, pv_a, pv_b : DblDyneVec; + rd_a, rd_b, pcnt_trace : DblDyneVec; + root_df : IntDyneVec; + a_vars, b_vars : StrDyneVec; + selected : IntDyneVec; + RowLabels, ColLabels : StrDyneVec; + CanLabels : StrDyneVec; + title : string; + errorcode : boolean = false; + +begin + count := 0; + k := 0; + no_factors := 0; + pcnt_extracted := 0.0; + trace := 0.0; + minroot := 0.0; + critical_prob := 0.0; + Pillia := 0.0; + chisqr := 0.0; + HLTrace := 0.0; + chiprob := 0.0; + + // Get size of the Left and Right matrices (predictors and dependents) + a_size := NLeft; + b_size:= NRight; + novars:= a_size + b_size; + + // allocate memory for matrices and vectors + SetLength(raa,NLeft+1,NLeft+1); + SetLength(rbb,NRight+1,NRight+1); + SetLength(rab,NLeft+1,NRight+1); + SetLength(rba,NRight+1,NLeft+1); + SetLength(bigmat,novars+1,novars+1); + SetLength(prod,novars+1,novars+1); + SetLength(first_prod,novars+1,novars+1); + SetLength(second_prod,novars+1,novars+1); + SetLength(char_equation,novars+1,novars+1); + SetLength(raainv,NLeft,NLeft); + SetLength(rbbinv,NRight,NRight); + SetLength(eigenvectors,novars,novars); + SetLength(norm_a,novars,novars); + SetLength(norm_b,novars,novars); + SetLength(raw_a,novars,novars); + SetLength(raw_b,novars,novars); + SetLength(a_cors,NLeft+1,NLeft+1); + SetLength(b_cors,NRight+1,NRight+1); + SetLength(eigentrans,novars,novars); + SetLength(theta,novars,novars); + SetLength(tempmat,novars,novars); + + SetLength(mean,novars); + SetLength(variance,novars); + SetLength(stddev,novars); + SetLength(roots,novars); + SetLength(root_chi,novars); + SetLength(chi_prob,novars); + SetLength(pv_a,novars); + SetLength(pv_b,novars); + SetLength(rd_a,novars); + SetLength(rd_b,novars); + SetLength(pcnt_trace,novars); + + SetLength(root_df,novars); + SetLength(a_vars,NLeft); + SetLength(b_vars,NRight); + SetLength(CanLabels,novars); + SetLength(RowLabels,novars); + SetLength(ColLabels,novars); + SetLength(selected,novars); + + //------------ WORK STARTS HERE! ------------------------------------- + + // Build labels for canonical functions 1 to novars + if b_size < a_size then + for i := 0 to b_size-1 do CanLabels[i] := 'CanVar' + IntToStr(i+1) + else for i := 0 to a_size-1 do CanLabels[i] := 'CanVar' + IntToStr(i+1); + + for i := 0 to a_size - 1 do // identify left variables + begin + a_vars[i] := Labels[i]; + selected[i] := GridPlace[i]; + end; + + for i := 0 to b_size - 1 do // identify right variables + begin + b_vars[i] := Labels[NLeft+i]; + selected[NLeft+i] := GridPlace[NLeft+i]; + end; + + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('CANONICAL CORRELATION ANALYSIS'); + OutputFrm.RichEdit.Lines.Add(''); + count := NoCases; + // Get means, standard deviations, etc. for total matrix + IER := Dyncorrelations(novars,selected,datagrid,bigmat,mean,variance,stddev,totalobs,3); + if (IER = 1)then + begin + ShowMessage('ERROR! Zero variance found for a variable-terminating'); + goto cleanup; + end; + + //partition matrix into quadrants + for i := 0 to a_size - 1 do + for j := 0 to a_size - 1 do raa[i,j]:= bigmat[i,j]; + + for i := a_size to novars - 1 do + for j := a_size to novars - 1 do + rbb[i-a_size,j-a_size] := bigmat[i,j]; + + for i := 0 to a_size - 1 do + for j := a_size to novars - 1 do + rab[i,j-a_size] := bigmat[i,j]; + + for i := a_size to novars - 1 do + for j := 0 to a_size - 1 do + rba[i-a_size,j] := bigmat[i,j]; + + if CorsChk.Checked then + begin + title := 'Left Correlation Matrix'; + MAT_PRINT(raa,NLeft,NLeft,title,a_vars,a_vars,totalobs); + title := 'Right Correlation Matrix'; + MAT_PRINT(rbb,NRight,NRight,title,b_vars,b_vars,totalobs); + title := 'Left-Right Correlation Matrix'; + MAT_PRINT(rab,NLeft,NRight,title,a_vars,b_vars,totalobs); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + // get inverses of left and right hand matrices raa and rbb + for i := 0 to a_size-1 do + for j := 0 to a_size-1 do + tempmat[i,j] := raa[i,j]; + SVDInverse(tempmat,a_size); + for i := 0 to a_size-1 do + for j := 0 to a_size-1 do raainv[i,j] := tempmat[i,j]; + if CorsChk.Checked then + begin + title := 'Inverse of Left Matrix'; + MAT_PRINT(raainv,a_size,a_size,title,a_vars,a_vars,totalobs); + end; + + for i := 0 to b_size-1 do + for j := 0 to b_size-1 do + tempmat[i,j] := rbb[i,j]; // inverse uses 1 offset + SVDInverse(tempmat,b_size); + for i := 0 to b_size-1 do // reset to 0 offset + for j := 0 to b_size - 1 do rbbinv[i,j] := tempmat[i,j]; + if CorsChk.Checked then + begin + title := 'Inverse of Right Matrix'; + MAT_PRINT(rbbinv,b_size,b_size,title,b_vars,b_vars,totalobs); + end; + + // get products of raainv x rab and the rbbinv x rba matrix + for i := 0 to b_size-1 do + for j := 0 to a_size-1 do first_prod[i,j] := 0.0; + MatAxB(first_prod,rbbinv,rba,b_size,b_size,b_size,a_size,errorcode); + for i := 0 to a_size-1 do + for j := 0 to b_size-1 do second_prod[i,j] := 0.0; + MatAxB(second_prod,raainv,rab,a_size,a_size,a_size,b_size,errorcode); + title := 'Right Inverse x Right-Left Matrix'; + MAT_PRINT(first_prod,b_size,a_size,title,b_vars,a_vars,totalobs); + title := 'Left Inverse x Left-Right Matrix'; + MAT_PRINT(second_prod,a_size,b_size,title,a_vars,b_vars,totalobs); + + //get characteristic equations matrix (product of last two product matrices + //The product should yeild rows and cols representing the smaller of the two sets + for i := 0 to b_size-1 do + for j := 0 to b_size - 1 do char_equation[i,j] := 0.0; + MatAxB(char_equation,first_prod,second_prod,b_size,a_size,a_size,b_size,errorcode); + title := 'Canonical Function'; + MAT_PRINT(char_equation,b_size,b_size,title,CanLabels,CanLabels,totalobs); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // now get roots and vectors of the characteristic equation using + // NonSymRoots routine + minroot := 0.0; + for i := 0 to b_size - 1 do + begin + roots[i] := 0.0; + pcnt_trace[i] := 0.0; + for j := 0 to b_size - 1 do eigenvectors[i,j] := 0.0; + end; + trace := 0.0; + no_factors := b_size; + Dynnonsymroots(char_equation, b_size, no_factors, minroot, eigenvectors, roots, + pcnt_trace, trace, pcnt_extracted); + + + outline := format('Trace of the matrix:=%10.4f',[trace]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Percent of trace extracted: %10.4f',[pcnt_extracted]); + OutputFrm.RichEdit.Lines.Add(outline); + + // Normalize smaller set weights and coumpute larger set weights + for i := 0 to b_size - 1 do // transpose eigenvectors + for j := 0 to b_size - 1 do eigentrans[j,i] := eigenvectors[i,j]; + for i := 0 to b_size - 1 do + for j := 0 to b_size-1 do tempmat[i,j] := 0.0; + MatAxB(tempmat,eigentrans,rbb,b_size,b_size,b_size,b_size,errorcode); + for i := 0 to b_size-1 do + for j := 0 to b_size-1 do theta[i,j] := 0.0; + MatAxB(theta,tempmat,eigenvectors,b_size,b_size,b_size,b_size,errorcode); + for j := 0 to b_size - 1 do + begin + q := 1.0 / sqrt(theta[j,j]); + for i := 0 to b_size - 1 do + begin + norm_b[i,j] := eigenvectors[i,j] * q; + raw_b[i,j] := norm_b[i,j] / stddev[a_size+i]; + end; + end; + for i := 0 to a_size - 1 do + for j := 0 to b_size - 1 do norm_a[i,j] := 0.0; + MatAxB(norm_a,second_prod,norm_b,a_size,b_size,b_size,b_size,errorcode); + for j := 0 to b_size-1 do + begin + for i := 0 to a_size-1 do + begin + norm_a[i,j] := norm_a[i,j] * (1.0 / sqrt(roots[j])); + raw_a[i,j] := norm_a[i,j] / stddev[i]; + end; + end; + + // Compute the correlations between variables and canonical variables + for i := 0 to a_size-1 do + for j := 0 to b_size-1 do a_cors[i,j] := 0.0; + MatAxB(a_cors,raa,norm_a,a_size,a_size,a_size,b_size,errorcode); + for j := 0 to b_size-1 do + begin + q := 0.0; + for i := 0 to a_size-1 do q := q + norm_a[i,j] * a_cors[i,j]; + q := 1.0 / sqrt(q); + for i := 0 to a_size-1 do a_cors[i,j] := a_cors[i,j] * q; + end; + for i := 0 to b_size-1 do + for j := 0 to b_size-1 do b_cors[i,j] := 0.0; + MatAxB(b_cors,rbb,norm_b,b_size,b_size,b_size,b_size,errorcode); + for j := 0 to b_size-1 do + begin + q := 0.0; + for i := 0 to b_size-1 do q := q + norm_b[i,j] * b_cors[i,j]; + q := 1.0 / sqrt(q); + for i := 0 to b_size-1 do b_cors[i,j] := b_cors[i,j] * q; + end; + + // Compute the Proportions of Variance (PVs) and Redundancy Coefficients + for j := 0 to b_size-1 do + begin + pv_a[j] := 0.0; + for i := 0 to a_size-1 do pv_a[j] := pv_a[j] + (a_cors[i,j] * a_cors[i,j]); + pv_a[j] := pv_a[j] / a_size; + rd_a[j] := pv_a[j] * roots[j]; + end; + for j := 0 to b_size-1 do + begin + pv_b[j] := 0.0; + for i := 0 to b_size-1 do pv_b[j] := pv_b[j] + (b_cors[i,j] * b_cors[i,j]); + pv_b[j] := pv_b[j] / b_size; + rd_b[j] := pv_b[j] * roots[j]; + end; + + // Compute tests of the roots + q := a_size + b_size + 1; + q := -(count - 1.0 - (q / 2.0)); + k := 0; + for i := 0 to b_size-1 do + begin + w := 1.0; + for j := i to b_size-1 do w := w * (1.0 - roots[j]); + root_chi[i] := q * ln(w); + root_df[i] := (a_size - i) * (b_size - i); + chi_prob[i] := 1.0 - chisquaredprob(root_chi[i],root_df[i]); + if (chi_prob[i] < critical_prob) then k := k + 1; + end; + Roys := roots[1] / (1.0 - roots[1]); + Lambda := 1.0; + for i := 0 to b_size-1 do + begin + Hroot := roots[i] / (1.0 - roots[i]); + Lambda := Lambda * (1.0 / (1.0 + Hroot)); + Pillia := Pillia + (Hroot / (1.0 + Hroot)); + HLTrace := HLTrace + Hroot; + end; + + // Print remaining results + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add(''); + outline := ' Canonical R Root % Trace Chi-Sqr D.F. Prob.'; + OutputFrm.RichEdit.Lines.Add(outline); + for i := 0 to b_size-1 do + begin + outline := format('%2d %10.6f %8.3f %7.3f %8.3f %2d %8.3f', + [i+1, sqrt(roots[i]), roots[i], pcnt_trace[i], root_chi[i], root_df[i], chi_prob[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + chisqr := -ln(Lambda) * (count - 1.0 - 0.5 * (a_size + b_size - 1.0)); + chiprob := 1.0 - chisquaredprob(chisqr,a_size * b_size); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Overall Tests of Significance:'); + OutputFrm.RichEdit.Lines.Add(' Statistic Approx. Stat. Value D.F. Prob.>Value'); + outline := format('Wilk''s Lambda Chi-Squared %10.4f %3d %6.4f', + [chisqr,a_size * b_size,chiprob]); + OutputFrm.RichEdit.Lines.Add(outline); + s := b_size; + m := 0.5 * (a_size - b_size - 1); + n := 0.5 * (count - b_size - a_size - 2); + f := (HLTrace * 2.0 * (s * n + 1)) / (s * s * (2.0 * m + s + 1.0)); + df1 := s * (2.0 * m + s + 1.0); + df2 := 2.0 * ( s * n + 1.0); + ftestprob := probf(f,df1,df2); + outline := format('Hotelling-Lawley Trace F-Test %10.4f %2.0f %2.0f %6.4f', + [f, df1,df2, ftestprob]); + OutputFrm.RichEdit.Lines.Add(outline); + df2 := s * (2.0 * n + s + 1.0); + f := (Pillia / (s - Pillia)) * ( (2.0 * n + s +1.0) / (2.0 * m + s + 1.0) ); + ftestprob := probf(f,df1,df2); + outline := format('Pillai Trace F-Test %10.4f %2.0f %2.0f %6.4f', + [f, df1,df2, ftestprob]); + OutputFrm.RichEdit.Lines.Add(outline); + Roys := Roys * (count - 1 - a_size + b_size)/ a_size ; + df1 := a_size; + df2 := count - 1 - a_size + b_size; + ftestprob := probf(Roys,df1,df2); + outline := format('Roys Largest Root F-Test %10.4f %2.0f %2.0f %6.4f', + [Roys, df1, df2, ftestprob]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + if CorsChk.Checked then + begin + title := 'Eigenvectors'; + MAT_PRINT(eigenvectors,b_size,b_size,title,CanLabels,CanLabels,totalobs); + OutputFrm.ShowModal(); + OutputFrm.RichEdit.Clear; + end; + + title := 'Standardized Right Side Weights'; + MAT_PRINT(norm_a,a_size,b_size,title,RowLabels,CanLabels,totalobs); + title := 'Standardized Left Side Weights'; + MAT_PRINT(norm_b,b_size,b_size,title,ColLabels,CanLabels,totalobs); + OutputFrm.ShowModal; + title := 'Raw Right Side Weights'; + MAT_PRINT(raw_a,a_size,b_size,title,RowLabels,CanLabels,totalobs); + title := 'Raw Left Side Weights'; + MAT_PRINT(raw_b,b_size,b_size,title,ColLabels,CanLabels,totalobs); + OutputFrm.ShowModal; + title := 'Right Side Correlations with Function'; + MAT_PRINT(a_cors,a_size,b_size,title,RowLabels,CanLabels,totalobs); + title := 'Left Side Correlations with Function'; + MAT_PRINT(b_cors,b_size,b_size,title,ColLabels,CanLabels,totalobs); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + if CorsChk.Checked then + begin + outline := 'Redundancy Analysis for Right Side Variables'; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := ' Variance Prop. Redundancy'; + OutputFrm.RichEdit.Lines.Add(outline); + for i := 0 to b_size-1 do + begin + outline := format('%10d %10.5f %10.5f',[i,pv_a[i],rd_a[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + outline := 'Redundancy Analysis for Left Side Variables'; + OutputFrm.RichEdit.Lines.Add(outline); + outline := ' Variance Prop. Redundancy'; + OutputFrm.RichEdit.Lines.Add(outline); + for i := 0 to b_size-1 do + begin + outline := format('%10d %10.5f %10.5f',[i,pv_b[i],rd_b[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + //------------- Now, clean up memory mess ---------------------------- +cleanup: + selected := nil; + ColLabels := nil; + RowLabels := nil; + CanLabels := nil; + b_vars := nil; + a_vars := nil; + root_df := nil; + pcnt_trace := nil; + rd_b := nil; + rd_a := nil; + pv_b := nil; + pv_a := nil; + chi_prob := nil; + root_chi := nil; + roots := nil; + stddev := nil; + variance := nil; + mean := nil; + tempmat := nil; + theta := nil; + eigentrans := nil; + b_cors := nil; + a_cors := nil; + raw_b := nil; + raw_a := nil; + norm_b := nil; + norm_a := nil; + eigenvectors := nil; + rbbinv := nil; + raainv := nil; + char_equation := nil; + second_prod := nil; + first_prod := nil; + prod := nil; + bigmat := nil; + rba := nil; + rab := nil; + rbb := nil; + raa := nil; +end; + +initialization + {$I glmunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/latinspecsunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/latinspecsunit.lfm new file mode 100644 index 000000000..fe17d0ad9 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/latinspecsunit.lfm @@ -0,0 +1,574 @@ +object LatinSpecsFrm: TLatinSpecsFrm + Left = 887 + Height = 519 + Top = 260 + Width = 420 + AutoSize = True + Caption = 'Latin Squares Analysis Specification Form' + ClientHeight = 519 + ClientWidth = 420 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 67 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'File Variables' + ParentColor = False + end + object Label8: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = nPerCellEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 491 + Width = 66 + BorderSpacing.Left = 8 + Caption = 'No. per cell: ' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel7 + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 445 + Top = 25 + Width = 232 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinWidth = 150 + ItemHeight = 0 + TabOrder = 0 + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 226 + Height = 25 + Top = 486 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object CancelBtn: TButton + AnchorSideRight.Control = OKBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 292 + Height = 25 + Top = 486 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 4 + end + object OKBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 366 + Height = 25 + Top = 486 + Width = 42 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'OK' + ModalResult = 1 + OnClick = OKBtnClick + TabOrder = 5 + end + object nPerCellEdit: TEdit + AnchorSideLeft.Control = Label8 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = OKBtn + AnchorSideTop.Side = asrCenter + AnchorSideRight.Side = asrBottom + Left = 82 + Height = 23 + Top = 487 + Width = 48 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 2 + Text = 'nPerCellEdit' + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = OKBtn + Left = 0 + Height = 8 + Top = 470 + Width = 420 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel7: TPanel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 248 + Height = 440 + Top = 25 + Width = 164 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + BevelOuter = bvNone + ChildSizing.VerticalSpacing = 16 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 440 + ClientWidth = 164 + TabOrder = 1 + object PanelA: TPanel + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 60 + Top = 0 + Width = 164 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 60 + ClientWidth = 164 + TabOrder = 0 + object ACodeLabel: TLabel + AnchorSideLeft.Control = ACodeEdit + AnchorSideBottom.Control = ACodeEdit + Left = 37 + Height = 15 + Top = 8 + Width = 119 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Factor A Code Variable' + ParentColor = False + end + object AInBtn: TBitBtn + AnchorSideLeft.Control = PanelA + AnchorSideTop.Control = PanelA + Left = 0 + Height = 28 + Top = 0 + Width = 29 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = AInBtnClick + Spacing = 0 + TabOrder = 0 + end + object AOutBtn: TBitBtn + AnchorSideLeft.Control = PanelA + AnchorSideTop.Control = AInBtn + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 32 + Width = 29 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = AOutBtnClick + Spacing = 0 + TabOrder = 1 + end + object ACodeEdit: TEdit + AnchorSideLeft.Control = AInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = PanelA + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = AOutBtn + AnchorSideBottom.Side = asrBottom + Left = 37 + Height = 23 + Top = 25 + Width = 127 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 2 + Text = 'ACodeEdit' + end + end + object PanelB: TPanel + Left = 0 + Height = 60 + Top = 76 + Width = 164 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 60 + ClientWidth = 164 + TabOrder = 1 + object BCodeLabel: TLabel + AnchorSideLeft.Control = BCodeEdit + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = BCodeEdit + Left = 37 + Height = 15 + Top = 8 + Width = 118 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Factor B Code Variable' + ParentColor = False + end + object BInBtn: TBitBtn + AnchorSideLeft.Control = PanelB + AnchorSideTop.Control = PanelB + Left = 0 + Height = 28 + Top = 0 + Width = 29 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = BInBtnClick + Spacing = 0 + TabOrder = 0 + end + object BOutBtn: TBitBtn + AnchorSideLeft.Control = PanelB + AnchorSideTop.Control = BInBtn + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 32 + Width = 29 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = BOutBtnClick + Spacing = 0 + TabOrder = 1 + end + object BCodeEdit: TEdit + AnchorSideLeft.Control = BInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = PanelB + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = BOutBtn + AnchorSideBottom.Side = asrBottom + Left = 37 + Height = 23 + Top = 25 + Width = 127 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 2 + Text = 'Edit1' + end + end + object PanelC: TPanel + Left = 0 + Height = 60 + Top = 152 + Width = 164 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 60 + ClientWidth = 164 + TabOrder = 2 + object CCodeLabel: TLabel + AnchorSideLeft.Control = CCodeEdit + AnchorSideBottom.Control = CCodeEdit + Left = 37 + Height = 15 + Top = 8 + Width = 119 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Factor C Code Variable' + ParentColor = False + end + object CInBtn: TBitBtn + AnchorSideLeft.Control = PanelC + AnchorSideTop.Control = PanelC + Left = 0 + Height = 28 + Top = 0 + Width = 29 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = CInBtnClick + Spacing = 0 + TabOrder = 0 + end + object COutBtn: TBitBtn + AnchorSideLeft.Control = PanelC + AnchorSideTop.Control = CInBtn + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 32 + Width = 29 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = COutBtnClick + Spacing = 0 + TabOrder = 1 + end + object CCodeEdit: TEdit + AnchorSideLeft.Control = CInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = PanelC + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = COutBtn + AnchorSideBottom.Side = asrBottom + Left = 37 + Height = 23 + Top = 25 + Width = 127 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 2 + Text = 'Edit1' + end + end + object PanelD: TPanel + Left = 0 + Height = 60 + Top = 228 + Width = 164 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 60 + ClientWidth = 164 + TabOrder = 3 + object DCodeLabel: TLabel + AnchorSideLeft.Control = DCodeEdit + AnchorSideBottom.Control = DCodeEdit + Left = 45 + Height = 15 + Top = 8 + Width = 119 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor D Code Variable' + ParentColor = False + end + object DInBtn: TBitBtn + AnchorSideLeft.Control = PanelD + AnchorSideTop.Control = PanelD + Left = 0 + Height = 28 + Top = 0 + Width = 29 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DInBtnClick + Spacing = 0 + TabOrder = 0 + end + object DOutBtn: TBitBtn + AnchorSideLeft.Control = PanelD + AnchorSideTop.Control = DInBtn + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 32 + Width = 29 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DOutBtnClick + Spacing = 0 + TabOrder = 1 + end + object DCodeEdit: TEdit + AnchorSideLeft.Control = DInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = PanelD + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DOutBtn + AnchorSideBottom.Side = asrBottom + Left = 37 + Height = 23 + Top = 25 + Width = 127 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 2 + Text = 'Edit1' + end + end + object PanelGrp: TPanel + Left = 0 + Height = 60 + Top = 304 + Width = 164 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 60 + ClientWidth = 164 + TabOrder = 4 + object GrpCodeLabel: TLabel + AnchorSideLeft.Control = GrpCodeEdit + AnchorSideBottom.Control = GrpCodeEdit + Left = 37 + Height = 15 + Top = 8 + Width = 108 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Group Code Variable' + ParentColor = False + end + object GrpInBtn: TBitBtn + AnchorSideLeft.Control = PanelGrp + AnchorSideTop.Control = PanelGrp + Left = 0 + Height = 28 + Top = 0 + Width = 29 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = GrpInBtnClick + Spacing = 0 + TabOrder = 0 + end + object GrpOutBtn: TBitBtn + AnchorSideLeft.Control = PanelGrp + AnchorSideTop.Control = GrpInBtn + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 32 + Width = 29 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = GrpOutBtnClick + Spacing = 0 + TabOrder = 1 + end + object GrpCodeEdit: TEdit + AnchorSideLeft.Control = GrpInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = PanelGrp + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GrpOutBtn + AnchorSideBottom.Side = asrBottom + Left = 37 + Height = 23 + Top = 25 + Width = 127 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 2 + Text = 'Edit1' + end + end + object PanelDep: TPanel + Left = 0 + Height = 60 + Top = 380 + Width = 164 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 60 + ClientWidth = 164 + TabOrder = 5 + object DepVarLabel: TLabel + AnchorSideLeft.Control = DepVarEdit + AnchorSideBottom.Control = DepVarEdit + Left = 37 + Height = 15 + Top = 8 + Width = 102 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + ParentColor = False + end + object DataInBtn: TBitBtn + AnchorSideLeft.Control = PanelDep + AnchorSideTop.Control = PanelDep + Left = 0 + Height = 28 + Top = 0 + Width = 29 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DataInBtnClick + Spacing = 0 + TabOrder = 0 + end + object DataOutBtn: TBitBtn + AnchorSideLeft.Control = PanelDep + AnchorSideTop.Control = DataInBtn + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 32 + Width = 29 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DataOutBtnClick + Spacing = 0 + TabOrder = 1 + end + object DepVarEdit: TEdit + AnchorSideLeft.Control = DataInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = PanelDep + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DataOutBtn + AnchorSideBottom.Side = asrBottom + Left = 37 + Height = 23 + Top = 25 + Width = 127 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 2 + Text = 'Edit1' + end + end + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/latinspecsunit.pas b/applications/lazstats/source/forms/analysis/comparisons/latinspecsunit.pas new file mode 100644 index 000000000..9e1dffe5f --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/latinspecsunit.pas @@ -0,0 +1,273 @@ +unit LatinSpecsUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, + MainUnit, Globals; + +type + + { TLatinSpecsFrm } + + TLatinSpecsFrm = class(TForm) + AInBtn: TBitBtn; + nPerCellEdit: TEdit; + GrpOutBtn: TBitBtn; + DataInBtn: TBitBtn; + DataOutBtn: TBitBtn; + AOutBtn: TBitBtn; + BInBtn: TBitBtn; + BOutBtn: TBitBtn; + CInBtn: TBitBtn; + COutBtn: TBitBtn; + DInBtn: TBitBtn; + DOutBtn: TBitBtn; + GrpInBtn: TBitBtn; + Label8: TLabel; + PanelA: TPanel; + PanelB: TPanel; + PanelC: TPanel; + PanelD: TPanel; + PanelGrp: TPanel; + PanelDep: TPanel; + Panel7: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + OKBtn: TButton; + ACodeEdit: TEdit; + BCodeEdit: TEdit; + CCodeEdit: TEdit; + DCodeEdit: TEdit; + GrpCodeEdit: TEdit; + DepVarEdit: TEdit; + Label1: TLabel; + ACodeLabel: TLabel; + BCodeLabel: TLabel; + CCodeLabel: TLabel; + DCodeLabel: TLabel; + GrpCodeLabel: TLabel; + DepVarLabel: TLabel; + VarList: TListBox; + Bevel1: TBevel; + procedure AInBtnClick(Sender: TObject); + procedure AOutBtnClick(Sender: TObject); + procedure BInBtnClick(Sender: TObject); + procedure BOutBtnClick(Sender: TObject); + procedure CInBtnClick(Sender: TObject); + procedure COutBtnClick(Sender: TObject); + procedure DataInBtnClick(Sender: TObject); + procedure DataOutBtnClick(Sender: TObject); + procedure DInBtnClick(Sender: TObject); + procedure DOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure GrpInBtnClick(Sender: TObject); + procedure GrpOutBtnClick(Sender: TObject); + procedure OKBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + public + { public declarations } + end; + +var + LatinSpecsFrm: TLatinSpecsFrm; + +implementation + +uses + Math, + LatinSqrsUnit; + + +{ TLatinSpecsFrm } + +procedure TLatinSpecsFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TLatinSpecsFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + w := MaxValue([ResetBtn.Width, CancelBtn.Width, OKBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + OKBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinHeight := Panel7.Height; + + Constraints.MinWidth := nPerCellEdit.Left + nPerCellEdit.Width + Width - ResetBtn.Left + ResetBtn.BorderSpacing.Left; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TLatinSpecsFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TLatinSpecsFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TLatinSpecsFrm.GrpInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + GrpCodeEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + GrpInBtn.Enabled := false; + GrpOutBtn.Enabled := true; +end; + +procedure TLatinSpecsFrm.GrpOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(GrpCodeEdit.Text); + GrpCodeEdit.Text := ''; + GrpInBtn.Enabled := true; + GrpOutBtn.Enabled := false; +end; + +procedure TLatinSpecsFrm.AInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + ACodeEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + AinBtn.Enabled := false; + AOutBtn.Enabled := true; +end; + +procedure TLatinSpecsFrm.AOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(ACodeEdit.Text); + ACodeEdit.Text := ''; + AinBtn.Enabled := true; + AOutBtn.Enabled := false; +end; + +procedure TLatinSpecsFrm.BInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + BCodeEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + BinBtn.Enabled := false; + BOutBtn.Enabled := true; +end; + +procedure TLatinSpecsFrm.BOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(BCodeEdit.Text); + BCodeEdit.Text := ''; + BinBtn.Enabled := true; + BOutBtn.Enabled := false; +end; + +procedure TLatinSpecsFrm.CInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + CCodeEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + CinBtn.Enabled := false; + COutBtn.Enabled := true; +end; + +procedure TLatinSpecsFrm.COutBtnClick(Sender: TObject); +begin + VarList.Items.Add(CCodeEdit.Text); + CCodeEdit.Text := ''; + CinBtn.Enabled := true; + COutBtn.Enabled := false; +end; + +procedure TLatinSpecsFrm.DataInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + DepVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + DataInBtn.Enabled := false; + DataOutBtn.Enabled := true; +end; + +procedure TLatinSpecsFrm.DataOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(DepVarEdit.Text); + DepVarEdit.Text := ''; + DataInBtn.Enabled := true; + DataOutBtn.Enabled := false; +end; + +procedure TLatinSpecsFrm.DInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + DCodeEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + DinBtn.Enabled := false; + DOutBtn.Enabled := true; +end; + +procedure TLatinSpecsFrm.DOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(DCodeEdit.Text); + DCodeEdit.Text := ''; + DinBtn.Enabled := true; + DOutBtn.Enabled := false; +end; + +procedure TLatinSpecsFrm.OKBtnClick(Sender: TObject); +var + C: TWinControl; + msg: String; +begin + if not Validate(msg, C) then begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + ModalResult := mrNone; + end; +end; + +function TLatinSpecsFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + n: Integer; +begin + Result := false; + if (nPerCellEdit.Text = '') then begin + AMsg := 'Please specify the number of cases per cell.'; + AControl := nPercellEdit; + exit; + end; + if not TryStrToInt(nPercellEdit.Text, n) or (n <= 0) then begin + AMsg := 'Please specify a valid number for the cases per cell.'; + AControl := nPercellEdit; + exit; + end; + Result := true; +end; + + +initialization + {$I latinspecsunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/latinsqrsunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/latinsqrsunit.lfm new file mode 100644 index 000000000..aa77da113 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/latinsqrsunit.lfm @@ -0,0 +1,109 @@ +object LatinSqrsFrm: TLatinSqrsFrm + Left = 199 + Height = 248 + Top = 108 + Width = 523 + ActiveControl = Plan + AutoSize = True + BorderStyle = bsDialog + Caption = 'Latin and Greco-Latin Squares Analyses' + ClientHeight = 248 + ClientWidth = 523 + OnActivate = FormActivate + OnCreate = FormCreate + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CancelBtn: TButton + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Plan + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = OKBtn + Left = 399 + Height = 25 + Top = 214 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object OKBtn: TButton + AnchorSideTop.Control = Plan + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 473 + Height = 25 + Top = 214 + Width = 42 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'OK' + ModalResult = 1 + OnClick = OKBtnClick + TabOrder = 3 + end + object Plan: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 198 + Top = 8 + Width = 515 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Winer''s Plans:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 178 + ClientWidth = 511 + Items.Strings = ( + 'Plan 1. Three Factors (A,B,C) with no interactions.' + 'Plan 2. Four Factors (A,B,C,D) with partial interactions.' + 'Plan 3. Like Plan 2 but different assumptions (Partial confounding of interaction ABC.)' + 'The Greco-Latin with no interactions assumed.' + 'Plan 5. Repeated measures Latin Square (random assignment of groups to rows.)' + 'Plan 6. Fractional replication of a three factor factorial experiment in incomplete blocks.' + 'Plan 7. Plan 5 with superimposing of an orthogonal Latin square.' + 'Plan 9. AxBxC (same square used for all levels of Factor C.)' + ) + OnClick = PlanClick + TabOrder = 0 + end + object HelpBtn: TButton + Tag = 130 + AnchorSideTop.Control = Plan + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CancelBtn + Left = 340 + Height = 25 + Top = 214 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 1 + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/latinsqrsunit.pas b/applications/lazstats/source/forms/analysis/comparisons/latinsqrsunit.pas new file mode 100644 index 000000000..3b31b575b --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/latinsqrsunit.pas @@ -0,0 +1,4542 @@ +unit LatinSqrsUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + LatinSpecsUnit, MainUnit, Globals, FunctionsLib, OutputUnit, GraphLib, + MatrixLib, ContextHelpUnit; + +type + + { TLatinSqrsFrm } + + TLatinSqrsFrm = class(TForm) + CancelBtn: TButton; + HelpBtn: TButton; + OKBtn: TButton; + Plan: TRadioGroup; + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure OKBtnClick(Sender: TObject); + procedure PlanClick(Sender: TObject); + private + { private declarations } + Btn : integer; + procedure Plan1(Sender: TObject); + procedure Plan2(Sender: TObject); + procedure Plan3(Sender: TObject); + procedure Plan4(Sender: TObject); + procedure Plan5(Sender: TObject); + procedure Plan6(Sender: TObject); + procedure Plan7(Sender: TObject); +// procedure Plan8(Sender: TObject); + procedure Plan9(Sender: TObject); + + public + { public declarations } + end; + +var + LatinSqrsFrm: TLatinSqrsFrm; + +implementation + +uses + Math; + +{ TLatinSqrsFrm } + +procedure TLatinSqrsFrm.OKBtnClick(Sender: TObject); +begin + case Btn of + 1 : begin + Plan1(Self); + end; + 2 : begin + Plan2(Self); + end; + 3 : begin + Plan3(Self); + end; + 4 : begin + Plan4(Self); + end; + 5 : begin + Plan5(Self); + end; + 6 : begin + Plan6(Self); + end; + 7 : begin + Plan7(Self); + end; + 8 : begin + Plan9(Self); + end; + end; + Close; +end; + +procedure TLatinSqrsFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([HelpBtn.Width, CancelBtn.Width, OKBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + OKBtn.Constraints.MinWidth := w; +end; + +procedure TLatinSqrsFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if LatinSpecsFrm = nil then + Application.CreateForm(TLatinSpecsFrm, LatinSpecsFrm); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TLatinSqrsFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TLatinSqrsFrm.PlanClick(Sender: TObject); +begin + Btn := Plan.ItemIndex + 1; +end; + +procedure TLatinSqrsFrm.Plan1(Sender: TObject); +label cleanup; +var + NoFactors : integer; + n : integer; // no. of subjects per cell + Acol, Bcol, Ccol, DataCol : integer; // variable columns in grid + FactorA : string; + FactorB : string; + FactorC : string; + DataVar : string; + cellstring : string; + i, j, minA, minB, minC, maxA, maxB, maxC, rangeA, rangeB, rangeC : integer; + value : integer; + cellcnts : IntDyneMat; + celltotals : DblDyneMat; + Ctotals : DblDyneVec; + design : StrDyneMat; + G, term1, term2, term3, term4, term5, term6, sumxsqr : double; + sumAsqr, sumBsqr, sumCsqr, sumABCsqr, SSA, SSB, SSC : double; + SSbetween, SSwithin, SSres, SStotal : double; + MSa, MSb, MSc, MSres, MSwithin : double; + data, GrandMean : double; + p, row, col, slice : integer; + dfa, dfb, dfc, dfres, dfwithin, dftotal, fa, fb, fc, fpartial : double; + proba, probb, probc, probpartial : double; + +begin + NoFactors := 3; + LatinSpecsFrm.PanelD.Visible := false; + LatinSpecsFrm.PanelGrp.Visible := false; + LatinSpecsFrm.AinBtn.Enabled := true; + LatinSpecsFrm.AoutBtn.Enabled := false; + LatinSpecsFrm.BinBtn.Enabled := true; + LatinSpecsFrm.BoutBtn.Enabled := false; + LatinSpecsFrm.CinBtn.Enabled := true; + LatinSpecsFrm.CoutBtn.Enabled := false; +// LatinSpecsFrm.DCodeLabel.Visible := false; +// LatinSpecsFrm.GrpCodeLabel.Visible := false; +// LatinSpecsFrm.DinBtn.Visible := false; +// LatinSpecsFrm.DoutBtn.Visible := false; + LatinSpecsFrm.ACodeEdit.Text := ''; + LatinSpecsFrm.BCodeEdit.Text := ''; + LatinSpecsFrm.CCodeEdit.Text := ''; + LatinSpecsFrm.DCodeEdit.Text := ''; + LatinSpecsFrm.GrpCodeEdit.Text := ''; + LatinSpecsFrm.DepVarEdit.Text := ''; + LatinSpecsFrm.nPerCellEdit.Text := ''; +// LatinSpecsFrm.DCodeEdit.Visible := false; +// LatinSpecsFrm.GrpInBtn.Visible := false; +// LatinSpecsFrm.GrpOutBtn.Visible := false; +// LatinSpecsFrm.GrpCodeEdit.Visible := false; + LatinSpecsFrm.DataInBtn.Enabled := true; + LatinSpecsFrm.DataOutBtn.Enabled := false; + + if LatinSpecsFrm.ShowModal = mrCancel then + exit; + + n := StrToInt(LatinSpecsFrm.nPerCellEdit.Text); + FactorA := LatinSpecsFrm.ACodeEdit.Text; + FactorB := LatinSpecsFrm.BCodeEdit.Text; + FactorC := LatinSpecsFrm.CCodeEdit.Text; + DataVar := LatinSpecsFrm.DepVarEdit.Text; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = FactorA) then ACol := i; + if (cellstring = FactorB) then BCol := i; + if (cellstring = FactorC) then Ccol := i; + if (cellstring = DataVar) then DataCol := i; + end; + // determine no. of levels in A, B and C + minA := 1000; + minB := 1000; + minC := 1000; + maxA := -1000; + maxB := -1000; + maxC := -1000; + for i := 1 to NoCases do + begin + value := StrToInt(OS3MainFrm.DataGrid.Cells[ACol,i]); + if value < minA then minA := value; + if value > maxA then maxA := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[BCol,i]); + if value < minB then minB := value; + if value > maxB then maxB := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + if value < minC then minC := value; + if value > maxC then maxC := value; + end; + rangeA := maxA - minA + 1; + rangeB := maxB - minB + 1; + rangeC := maxC - minC + 1; + + // check for squareness + if ( (rangeA <> rangeB) or (rangeA <> rangeC) or (rangeB <> rangeC)) then + begin + ShowMessage('ERROR! In a Latin square the range of values should all be equal!'); + exit; + end; + p := rangeA; + + // set up an array for cell counts and for cell sums and marginal sums + SetLength(cellcnts,rangeA+1,rangeB+1); + SetLength(celltotals,rangeA+1,rangeB+1); + SetLength(Ctotals,rangeC+1); + SetLength(Design,rangeA,rangeB); + + // initialize arrays and values + for i := 0 to rangeA do + begin + for j := 0 to rangeB do + begin + cellcnts[i,j] := 0; + celltotals[i,j] := 0.0; + end; + end; + for i := 0 to rangeC-1 do Ctotals[i] := 0; + G := 0.0; + sumxsqr := 0.0; + sumAsqr := 0.0; + sumBsqr := 0.0; + sumCsqr := 0.0; + sumABCsqr := 0.0; + term1 := 0.0; + term2 := 0.0; + term3 := 0.0; + term4 := 0.0; + term5 := 0.0; + term6 := 0.0; + GrandMean := 0.0; + + // Read in the data + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + slice := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + data := StrToFloat(OS3MainFrm.DataGrid.Cells[DataCol,i]); + cellcnts[row-1,col-1] := cellcnts[row-1,col-1] + 1; + celltotals[row-1,col-1] := celltotals[row-1,col-1] + data; + Ctotals[slice-1] := Ctotals[slice-1] + data; + sumxsqr := sumxsqr + (data * data); + GrandMean := GrandMean + data; + end; + + // check for equal cell counts + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + if cellcnts[i,j] <> n then + begin + ShowMessage('cell sizes are not equal!'); + goto cleanup; + end; + end; + end; + + // calculate values + for i := 0 to p - 1 do // get row and column sums + begin + for j := 0 to p-1 do + begin + celltotals[i,p] := celltotals[i,p] + celltotals[i,j]; + celltotals[p,j] := celltotals[p,j] + celltotals[i,j]; + sumABCsqr := sumABCsqr + (celltotals[i,j] * celltotals[i,j]); + end; + end; + for i := 0 to p-1 do G := G + Ctotals[i]; + term1 := (G * G) / (n * p * p); + term2 := sumxsqr; + for i := 0 to p-1 do // sum of squared A's + sumAsqr := sumAsqr + (celltotals[i,p] * celltotals[i,p]); + for i := 0 to p-1 do // sum of squared B's + sumBsqr := sumBsqr + (celltotals[p,i] * celltotals[p,i]); + for i := 0 to p-1 do // sum of squared C's + sumCsqr := sumCsqr + (Ctotals[i] * Ctotals[i]); + term3 := sumAsqr / (n * p); + term4 := sumBsqr / (n * p); + term5 := sumCsqr / (n * p); + term6 := sumABCsqr / n; + SSA := term3 - term1; + SSB := term4 - term1; + SSC := term5 - term1; + SSbetween := term6 - term1; + SSwithin := term2 - term6; + SSres := term6 - term3 - term4 - term5 + 2 * term1; + SStotal := SSA + SSB + SSC + SSres + SSwithin; + dfa := p-1; + dfb := p-1; + dfc := p-1; + dfres := (p-1) * (p-2); + dfwithin := (p * p) * (n - 1); + dftotal := n * p * p - 1; + MSa := SSA / dfa; + MSb := SSB / dfb; + MSc := SSC / dfc; + MSres := SSres / dfres; + MSwithin := SSwithin / dfwithin; + fa := MSa / MSwithin; + fb := MSb / MSwithin; + fc := MSc / MSwithin; + fpartial := MSres / MSwithin; + proba := probf(fa,dfa,dfwithin); + probb := probf(fb,dfb,dfwithin); + probc := probf(fc,dfc,dfwithin); + probpartial := probf(fpartial,dfres,dfwithin); + + // show ANOVA table results + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Latin Square Analysis Plan 1 Results'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + OutputFrm.RichEdit.Lines.Add('Source SS DF MS F Prob.>F'); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + cellstring := 'Factor A '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSA,dfa,MSa,fa,proba]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Factor B '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSB,dfb,MSb,fb,probb]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Factor C '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSC,dfc,MSc,fc,probc]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Residual '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSres,dfres,MSres,fpartial,probpartial]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Within '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f',[SSwithin, dfwithin, MSwithin]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Total '; + cellstring := cellstring + format('%9.3f %9.0f',[SStotal, dftotal]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + + // show design + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Experimental Design'); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + slice := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + Design[row-1,col-1] := 'C' + IntToStr(slice); + end; + for i := 0 to p - 1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + begin + cellstring := cellstring + format('%5s',[Design[i,j]]); + end; + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + // show table cell means + for i := 0 to p-1 do + for j := 0 to p-1 do + celltotals[i,j] := celltotals[i,j] / n; + for i := 0 to p-1 do + begin + celltotals[i,p] := celltotals[i,p] / (p * n); + celltotals[p,i] := celltotals[p,i] / (p * n); + end; + GrandMean := GrandMean / (p * p * n); + for i := 0 to p-1 do Ctotals[i] := Ctotals[i] / (p * n); + + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Cell means and totals'); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 0 to p-1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[celltotals[i,j]]); + end; + cellstring := cellstring + format(' %8.3f ',[celltotals[i,p]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := 'Total '; + for j := 0 to p-1 do + cellstring := cellstring + format(' %8.3f ',[celltotals[p,j]]); + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + // show category means + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorC]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Ctotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.ShowModal; + +cleanup: + Design := nil; + Ctotals := nil; + celltotals := nil; + cellcnts := nil; +end; + +procedure TLatinSqrsFrm.Plan2(Sender: TObject); +label cleanup; +var + NoFactors : integer; + n : integer; // no. of subjects per cell + Acol, Bcol, Ccol, Dcol, DataCol : integer; // variable columns in grid + FactorA : string; + FactorB : string; + FactorC : string; + FactorD : string; + DataVar : string; + cellstring : string; + i, j, k, minA, minB, minC, maxA, maxB, maxC : integer; + minD, maxD, rangeD, rangeA, rangeB, rangeC : integer; + value : integer; + cellcnts : IntDyneCube; + celltotals : DblDyneCube; + Ctotals : DblDyneVec; + design : StrDyneMat; + G, term1, term2, term3, term4, term5, term6, term7, term8 : double; + term9, sumxsqr : double; + sumAsqr, sumBsqr, sumCsqr, sumDsqr, SSA, SSB, SSC, SSD : double; + sumADsqr, sumBDsqr, sumCDsqr : double; + ADmat, BDmat, CDmat : DblDyneMat; + SSAD, SSBD, SSCD, SSwithin, SSres, SStotal : double; + MSa, MSb, MSc, MSd, MSAD, MSBD, MSCD, MSres, MSwithin : double; + data, GrandMean : double; + p, row, col, slice, block : integer; + dfa, dfb, dfc, dfres, dfwithin, dftotal, fa, fb, fc, fpartial : double; + dfd, fd, fad, fbd, fcd, dfad, dfbd, dfcd : double; + proba, probb, probc, probd, probpartial : double; + probad, probbd, probcd: double; + +begin + NoFactors := 4; + LatinSpecsFrm.PanelD.Visible := true; + LatinSpecsFrm.PanelGrp.Visible := false; + LatinSpecsFrm.AinBtn.Enabled := true; + LatinSpecsFrm.AoutBtn.Enabled := false; + LatinSpecsFrm.BinBtn.Enabled := true; + LatinSpecsFrm.BoutBtn.Enabled := false; + LatinSpecsFrm.CinBtn.Enabled := true; + LatinSpecsFrm.CoutBtn.Enabled := false; + LatinSpecsFrm.DCodeEdit.Visible := true; + LatinSpecsFrm.ACodeEdit.Text := ''; + LatinSpecsFrm.BCodeEdit.Text := ''; + LatinSpecsFrm.CCodeEdit.Text := ''; + LatinSpecsFrm.DCodeEdit.Text := ''; + LatinSpecsFrm.GrpCodeEdit.Text := ''; + LatinSpecsFrm.DepVarEdit.Text := ''; + LatinSpecsFrm.nPerCellEdit.Text := ''; + LatinSpecsFrm.DinBtn.Enabled := true; + LatinSpecsFrm.DoutBtn.Enabled := false; + LatinSpecsFrm.DataInBtn.Enabled := true; + LatinSpecsFrm.DataOutBtn.Enabled := false; + LatinSpecsFrm.ShowModal; + if LatinSpecsFrm.ModalResult = mrCancel then exit; + n := StrToInt(LatinSpecsFrm.nPerCellEdit.Text); + if n <= 0 then + begin + ShowMessage('Please specify the number of cases per cell.'); + exit; + end; + FactorA := LatinSpecsFrm.ACodeEdit.Text; + FactorB := LatinSpecsFrm.BCodeEdit.Text; + FactorC := LatinSpecsFrm.CCodeEdit.Text; + FactorD := LatinSpecsFrm.DCodeEdit.Text; + DataVar := LatinSpecsFrm.DepVarEdit.Text; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = FactorA) then ACol := i; + if (cellstring = FactorB) then BCol := i; + if (cellstring = FactorC) then Ccol := i; + if (cellstring = FactorD) then Dcol := i; + if (cellstring = DataVar) then DataCol := i; + end; + // determine no. of levels in A, B and C + minA := 1000; + minB := 1000; + minC := 1000; + minD := 1000; + maxA := -1000; + maxB := -1000; + maxC := -1000; + maxD := -1000; + for i := 1 to NoCases do + begin + value := StrToInt(OS3MainFrm.DataGrid.Cells[ACol,i]); + if value < minA then minA := value; + if value > maxA then maxA := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[BCol,i]); + if value < minB then minB := value; + if value > maxB then maxB := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + if value < minC then minC := value; + if value > maxC then maxC := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Dcol,i]); + if value < minD then minD := value; + if value > maxD then maxD := value; + end; + rangeA := maxA - minA + 1; + rangeB := maxB - minB + 1; + rangeC := maxC - minC + 1; + rangeD := maxD - minD + 1; + + // check for squareness + if ( (rangeA <> rangeB) or (rangeA <> rangeC) or (rangeB <> rangeC)) then + begin + ShowMessage('ERROR! In a Latin square the range of values should all be equal!'); + exit; + end; + p := rangeA; + + // set up an array for cell counts and for cell sums and marginal sums + SetLength(cellcnts,rangeA+1,rangeB+1,rangeD+1); + SetLength(celltotals,rangeA+1,rangeB+1,rangeD+1); + SetLength(ADmat,rangeA+1,rangeD+1); + SetLength(BDmat,rangeB+1,rangeD+1); + SetLength(CDmat,rangeC+1,rangeD+1); + SetLength(Ctotals,rangeC+1); + SetLength(Design,rangeA,rangeB); + + // initialize arrays and values + for i := 0 to rangeA do + begin + for j := 0 to rangeB do + begin + for k := 0 to rangeD do + begin + cellcnts[i,j,k] := 0; + celltotals[i,j,k] := 0.0; + end; + end; + end; + for i := 0 to rangeA do + for j := 0 to rangeD do + ADmat[i,j] := 0.0; + for i := 0 to rangeB do + for j := 0 to rangeD do + BDmat[i,j] := 0.0; + for i := 0 to rangeC do + for j := 0 to rangeD do + CDmat[i,j] := 0.0; + for i := 0 to rangeC-1 do Ctotals[i] := 0; + G := 0.0; + sumxsqr := 0.0; + sumAsqr := 0.0; + sumBsqr := 0.0; + sumCsqr := 0.0; + sumDsqr := 0.0; + sumADsqr := 0.0; + sumBDsqr := 0.0; + sumCDsqr := 0.0; + term1 := 0.0; + term2 := 0.0; + term3 := 0.0; + term4 := 0.0; + term5 := 0.0; + term6 := 0.0; + term7 := 0.0; + term8 := 0.0; + term9 := 0.0; + GrandMean := 0.0; + SSwithin := 0.0; + + // Read in the data + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + slice := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + block := StrToInt(OS3MainFrm.DataGrid.Cells[Dcol,i]); + data := StrToFloat(OS3MainFrm.DataGrid.Cells[DataCol,i]); + cellcnts[row-1,col-1,block-1] := cellcnts[row-1,col-1,block-1] + 1; + celltotals[row-1,col-1,block-1] := celltotals[row-1,col-1,block-1] + data; + ADmat[row-1,block-1] := ADmat[row-1,block-1] + data; + BDmat[col-1,block-1] := BDmat[col-1,block-1] + data; + CDmat[slice-1,block-1] := CDmat[slice-1,block-1] + data; + Ctotals[slice-1] := Ctotals[slice-1] + data; + sumxsqr := sumxsqr + (data * data); + GrandMean := GrandMean + data; + end; + + // check for equal cell counts + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + for k := 0 to rangeD - 1 do + begin + if cellcnts[i,j,k] <> n then + begin + ShowMessage('cell sizes are not equal!'); + goto cleanup; + end; + end; + end; + end; + + // calculate values + for i := 0 to p - 1 do // get row, column and block sums + begin + for j := 0 to p-1 do + begin + for k := 0 to rangeD - 1 do + begin + celltotals[i,p,k] := celltotals[i,p,k] + celltotals[i,j,k]; + celltotals[p,j,k] := celltotals[p,j,k] + celltotals[i,j,k]; + celltotals[i,j,rangeD] :=celltotals[i,j,rangeD] + celltotals[i,j,k]; + end; + end; + end; + // get interaction AD + for i := 0 to rangeA-1 do + begin + for j := 0 to rangeD-1 do + begin + sumADsqr := sumADsqr + (ADmat[i,j] * ADmat[i,j]); + ADmat[i,rangeD] := ADmat[i,rangeD] + ADmat[i,j]; + ADmat[rangeA,j] := ADmat[rangeA,j] + ADmat[i,j]; + end; + end; + for i := 0 to rangeA-1 do + sumAsqr := sumAsqr + (ADmat[i,rangeD] * ADmat[i,rangeD]); + for i := 0 to rangeD-1 do + sumDsqr := sumDsqr + (ADmat[rangeA,i] * ADmat[rangeA,i]); + + // get interaction BD + for i := 0 to rangeB-1 do + begin + for j := 0 to rangeD-1 do + begin + sumBDsqr := sumBDsqr + (BDmat[i,j] * BDmat[i,j]); + BDmat[i,rangeD] := BDmat[i,rangeD] + BDmat[i,j]; + BDmat[rangeB,j] := BDmat[rangeB,j] + BDmat[i,j]; + end; + end; + for i := 0 to rangeB-1 do + sumBsqr := sumBsqr + (BDmat[i,rangeD] * BDmat[i,rangeD]); + + // get interaction CD + for i := 0 to rangeC-1 do + begin + for j := 0 to rangeD-1 do + begin + sumCDsqr := sumCDsqr + (CDmat[i,j] * CDmat[i,j]); + CDmat[i,rangeD] := CDmat[i,rangeD] + CDmat[i,j]; + CDmat[rangeC,j] := CDmat[rangeC,j] + CDmat[i,j]; + end; + end; + for i := 0 to rangeC-1 do + sumCsqr := sumCsqr + (CDmat[i,rangeD] * CDmat[i,rangeD]); + + G := GrandMean; + term1 := (G * G) / (n * p * p * rangeD); + term2 := sumxsqr; + term3 := sumAsqr / (n * p * rangeD); + term4 := sumBsqr / (n * p * rangeD); + term5 := sumCsqr / (n * p * rangeD); + term6 := sumADsqr / (n * p); + term7 := SumBDsqr / (n * p); + term8 := SumCDsqr / (n * p); + term9 := sumDsqr / (n * p * p); + SSA := term3 - term1; + SSD := term9 - term1; + SSAD := term6 - term3 - term9 + term1; + SSB := term4 - term1; + SSBD := term7 - term4 - term9 + term1; + SSC := term5 - term1; + SSCD := term8 - term5 - term9 + term1; + + // get ss within + for i := 0 to rangeA - 1 do + for j := 0 to rangeB - 1 do + for k := 0 to rangeD - 1 do + SSwithin := SSwithin + (celltotals[i,j,k] * celltotals[i,j,k]); + SSwithin := sumXsqr - (SSwithin / n); + + // get SS residual + SStotal := sumXsqr - term1; + SSres := SStotal - SSA - SSB - SSC - SSD - SSAD - SSBD - SSCD - SSwithin; + dfa := p-1; + dfb := p-1; + dfc := p-1; + dfd := rangeD - 1; + dfad := (p-1) * (rangeD - 1); + dfbd := dfad; + dfcd := dfad; + dfres := rangeD * (p-1) * (p-2); + dfwithin := (p * p) * rangeD * (n - 1); + dftotal := n * p * p * rangeD - 1; + MSa := SSA / dfa; + MSb := SSB / dfb; + MSc := SSC / dfc; + MSd := SSD / dfd; + MSad := SSAD / dfad; + MSbd := SSBD / dfbd; + MScd := SSCD / dfcd; + MSres := SSres / dfres; + MSwithin := SSwithin / dfwithin; + fa := MSa / MSwithin; + fb := MSb / MSwithin; + fc := MSc / MSwithin; + fd := MSd / MSwithin; + fad := MSad / MSwithin; + fbd := MSbd / MSwithin; + fcd := MScd / MSwithin; + fpartial := MSres / MSwithin; + proba := probf(fa,dfa,dfwithin); + probb := probf(fb,dfb,dfwithin); + probc := probf(fc,dfc,dfwithin); + probd := probf(fd,dfd,dfwithin); + probad := probf(fad,dfad,dfwithin); + probbd := probf(fbd,dfbd,dfwithin); + probcd := probf(fcd,dfcd,dfwithin); + probpartial := probf(fpartial,dfres,dfwithin); + + // show ANOVA table results + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Latin Square Analysis Plan 2 Results'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + OutputFrm.RichEdit.Lines.Add('Source SS DF MS F Prob.>F'); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + cellstring := 'Factor A '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSA,dfa,MSa,fa,proba]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Factor B '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSB,dfb,MSb,fb,probb]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Factor C '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSC,dfc,MSc,fc,probc]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Factor D '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSD,dfd,MSd,fd,probd]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'A x D '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSAD,dfad,MSad,fad,probad]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'B x D '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSBD,dfbd,MSbd,fbd,probbd]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'C x D '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSCD,dfcd,MScd,fcd,probcd]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Residual '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSres,dfres,MSres,fpartial,probpartial]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Within '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f',[SSwithin, dfwithin, MSwithin]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Total '; + cellstring := cellstring + format('%9.3f %9.0f',[SStotal, dftotal]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + + // show design for each block + for k := 0 to rangeD - 1 do + begin + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Experimental Design for block ' + format('%d',[k+1]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + slice := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + block := StrToInt(OS3MainFrm.DataGrid.Cells[Dcol,i]); + if block = minD + k then + Design[row-1,col-1] := 'C' + IntToStr(slice); + end; + for i := 0 to p - 1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + begin + cellstring := cellstring + format('%5s',[Design[i,j]]); + end; + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + + // get cell means + for i := 0 to p-1 do + for j := 0 to p-1 do + for k := 0 to rangeD - 1 do + celltotals[i,j,k] := celltotals[i,j,k] / n; + for i := 0 to p-1 do + begin + for k := 0 to rangeD - 1 do + begin + celltotals[i,p,k] := celltotals[i,p,k] / (p * n); + celltotals[p,i,k] := celltotals[p,i,k] / (p * n); + end; + end; + GrandMean := GrandMean / (p * p * n * rangeD); + for i := 0 to p-1 do Ctotals[i] := Ctotals[i] / (p * n * rangeD); + + // show table of means for each block + for k := 0 to rangeD-1 do + begin + OutputFrm.RichEdit.Lines.Add(''); + cellstring := format('BLOCK %d',[k+1]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Cell means and totals'); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 0 to p-1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[celltotals[i,j,k]]); + end; + cellstring := cellstring + format(' %8.3f ',[celltotals[i,p,k]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := 'Total '; + for j := 0 to p-1 do + cellstring := cellstring + format(' %8.3f ',[celltotals[p,j,k]]); + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + + // show category means + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorC]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Ctotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.ShowModal; + +cleanup: + Design := nil; + Ctotals := nil; + CDmat := nil; + BDmat := nil; + ADmat := nil; + celltotals := nil; + cellcnts := nil; +end; + +procedure TLatinSqrsFrm.Plan3(Sender: TObject); +label cleanup; +var + NoFactors : integer; + n : integer; // no. of subjects per cell + Acol, Bcol, Ccol, Dcol, DataCol : integer; // variable columns in grid + FactorA : string; + FactorB : string; + FactorC : string; + FactorD : string; + DataVar : string; + cellstring : string; + i, j, k, m, minA, minB, minC, maxA, maxB, maxC : integer; + minD, maxD, rangeA, rangeB, rangeC, rangeD : integer; + value : integer; + cellcnts : IntDyneCube; + celltotals : DblDyneQuad; + ABmat, ACmat, BCmat : DblDyneMat; + ABCmat : DblDyneCube; + Atotals : DblDyneVec; + Btotals : DblDyneVec; + Ctotals : DblDyneVec; + Dtotals : DblDyneVec; + design : StrDyneMat; + G, term1, term2, term3, term4, term5, term6, term7, term8 : double; + term9, term10, sumxsqr : double; + sumAsqr, sumBsqr, sumCsqr, sumDsqr, SSA, SSB, SSC, SSD : double; + sumABsqr, sumACsqr, sumBCsqr, sumABCsqr : double; + SSAB, SSAC, SSBC, SSABC, SSwithin, SStotal : double; + MSa, MSb, MSc, MSd, MSAB, MSAC, MSBC, MSABC, MSwithin : double; + data, GrandMean : double; + p, row, col, slice, block : integer; + dfa, dfb, dfc, dfwithin, dftotal, fa, fb, fc: double; + dfd, fd, fab, fac, fbc, fabc, dfab, dfac, dfbc, dfabc : double; + proba, probb, probc, probd: double; + probab, probac, probbc, probabc : double; + +begin + NoFactors := 4; + LatinSpecsFrm.PanelD.Visible := true; + LatinSpecsFrm.PanelGrp.Visible := false; + LatinSpecsFrm.AinBtn.Enabled := true; + LatinSpecsFrm.AoutBtn.Enabled := false; + LatinSpecsFrm.BinBtn.Enabled := true; + LatinSpecsFrm.BoutBtn.Enabled := false; + LatinSpecsFrm.CinBtn.Enabled := true; + LatinSpecsFrm.CoutBtn.Enabled := false; +// LatinSpecsFrm.DCodeEdit.Visible := true; + LatinSpecsFrm.ACodeEdit.Text := ''; + LatinSpecsFrm.BCodeEdit.Text := ''; + LatinSpecsFrm.CCodeEdit.Text := ''; + LatinSpecsFrm.DCodeEdit.Text := ''; + LatinSpecsFrm.GrpCodeEdit.Text := ''; + LatinSpecsFrm.DepVarEdit.Text := ''; + LatinSpecsFrm.nPerCellEdit.Text := ''; +// LatinSpecsFrm.GrpCodeEdit.Visible := false; +// LatinSpecsFrm.DCodeLabel.Visible := true; +// LatinSpecsFrm.GrpCodeLabel.Visible := false; +// LatinSpecsFrm.DinBtn.Visible := true; +// LatinSpecsFrm.DoutBtn.Visible := true; + LatinSpecsFrm.DinBtn.Enabled := true; + LatinSpecsFrm.DoutBtn.Enabled := false; +// LatinSpecsFrm.GrpInBtn.Visible := false; +// LatinSpecsFrm.GrpOutBtn.Visible := false; + LatinSpecsFrm.DataInBtn.Enabled := true; + LatinSpecsFrm.DataOutBtn.Enabled := false; + LatinSpecsFrm.ShowModal; + if LatinSpecsFrm.ModalResult = mrCancel then exit; + n := StrToInt(LatinSpecsFrm.nPerCellEdit.Text); + if n <= 0 then + begin + ShowMessage('Please specify the number of cases per cell.'); + exit; + end; + FactorA := LatinSpecsFrm.ACodeEdit.Text; + FactorB := LatinSpecsFrm.BCodeEdit.Text; + FactorC := LatinSpecsFrm.CCodeEdit.Text; + FactorD := LatinSpecsFrm.DCodeEdit.Text; + DataVar := LatinSpecsFrm.DepVarEdit.Text; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = FactorA) then ACol := i; + if (cellstring = FactorB) then BCol := i; + if (cellstring = FactorC) then Ccol := i; + if (cellstring = FactorD) then Dcol := i; + if (cellstring = DataVar) then DataCol := i; + end; + // determine no. of levels in A, B and C + minA := 1000; + minB := 1000; + minC := 1000; + minD := 1000; + maxA := -1000; + maxB := -1000; + maxC := -1000; + maxD := -1000; + for i := 1 to NoCases do + begin + value := StrToInt(OS3MainFrm.DataGrid.Cells[ACol,i]); + if value < minA then minA := value; + if value > maxA then maxA := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[BCol,i]); + if value < minB then minB := value; + if value > maxB then maxB := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + if value < minC then minC := value; + if value > maxC then maxC := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Dcol,i]); + if value < minD then minD := value; + if value > maxD then maxD := value; + end; + rangeA := maxA - minA + 1; + rangeB := maxB - minB + 1; + rangeC := maxC - minC + 1; + rangeD := maxD - minD + 1; + + // check for squareness + if ( (rangeA <> rangeB) or (rangeA <> rangeC) or (rangeB <> rangeC) or (rangeA <> rangeD) ) then + begin + ShowMessage('ERROR! In a Latin square the range of values should all be equal!'); + exit; + end; + p := rangeA; + + // set up an array for cell counts and for cell sums and marginal sums + SetLength(cellcnts,p+1,p+1,p+1); + SetLength(celltotals,p+1,p+1,p+1,p+1); + SetLength(ABmat,p+1,p+1); + SetLength(ACmat,p+1,p+1); + SetLength(BCmat,p+1,p+1); + SetLength(ABCmat,p+1,p+1,p+1); + SetLength(Atotals,p); + SetLength(Btotals,p); + SetLength(Ctotals,p); + SetLength(Dtotals,p); + SetLength(Design,p,p); + + // initialize arrays and values + for i := 0 to p do + for j := 0 to p do + for k := 0 to p do + for m := 0 to p do + celltotals[i,j,k,m] := 0.0; + for i := 0 to p do + begin + for j := 0 to p do + begin + ABmat[i,j] := 0.0; + ACmat[i,j] := 0.0; + BCmat[i,j] := 0.0; + end; + end; + for i := 0 to p do + begin + for j := 0 to p do + begin + for k := 0 to p do + begin + ABCmat[i,j,k] := 0.0; + cellcnts[i,j,k] := 0; + end; + end; + end; + for i := 0 to p-1 do + begin + Atotals[i] := 0.0; + Btotals[i] := 0.0; + Ctotals[i] := 0.0; + Dtotals[i] := 0.0; + end; + G := 0.0; + sumxsqr := 0.0; + sumAsqr := 0.0; + sumBsqr := 0.0; + sumCsqr := 0.0; + sumDsqr := 0.0; + sumABsqr := 0.0; + sumACsqr := 0.0; + sumBCsqr := 0.0; + sumABCsqr := 0.0; + term1 := 0.0; + term2 := 0.0; + term3 := 0.0; + term4 := 0.0; + term5 := 0.0; + term6 := 0.0; + term7 := 0.0; + term8 := 0.0; + term9 := 0.0; + term10 := 0.0; + GrandMean := 0.0; + SSwithin := 0.0; + + // Read in the data + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + slice := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + block := StrToInt(OS3MainFrm.DataGrid.Cells[Dcol,i]); + data := StrToFloat(OS3MainFrm.DataGrid.Cells[DataCol,i]); + cellcnts[row-1,col-1,slice-1] := cellcnts[row-1,col-1,slice-1] + 1; + celltotals[row-1,col-1,slice-1,block-1] := celltotals[row-1,col-1,slice-1,block-1] + data; + ABmat[row-1,col-1] := ABmat[row-1,col-1] + data; + ACmat[row-1,slice-1] := ACmat[row-1,slice-1] + data; + BCmat[col-1,slice-1] := BCmat[col-1,slice-1] + data; + ABCmat[row-1,col-1,slice-1] := ABCmat[row-1,col-1,slice-1] + data; + Atotals[row-1] := Atotals[row-1] + data; + Btotals[col-1] := Btotals[col-1] + data; + Ctotals[slice-1] := Ctotals[slice-1] + data; + Dtotals[block-1] := Dtotals[block-1] + data; + sumxsqr := sumxsqr + (data * data); + GrandMean := GrandMean + data; + end; + + // check for equal cell counts in ABCmat + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + for k := 0 to p - 1 do + begin + if cellcnts[i,j,k] <> n then + begin + ShowMessage('cell sizes are not equal!'); + goto cleanup; + end; + end; + end; + end; + + // calculate values + for i := 0 to p - 1 do // get row, column, slice and block sums + begin + for j := 0 to p-1 do + begin + for k := 0 to p - 1 do + begin + for m := 0 to p - 1 do + begin + celltotals[p,j,k,m] := celltotals[p,j,k,m] + celltotals[i,j,k,m]; + celltotals[i,p,k,m] := celltotals[i,p,k,m] + celltotals[i,j,k,m]; + celltotals[i,j,p,m] := celltotals[i,j,p,m] + celltotals[i,j,k,m]; + celltotals[i,j,k,p] := celltotals[i,j,k,p] + celltotals[i,j,k,m]; + end; + end; + end; + end; + for i := 0 to p - 1 do // get row, column and slice sums in ABC matrix + begin + for j := 0 to p-1 do + begin + for k := 0 to p-1 do + begin + ABCmat[p,j,k] := ABCmat[p,j,k] + ABCmat[i,j,k]; + ABCmat[i,p,k] := ABCmat[i,p,k] + ABCmat[i,j,k]; + ABCmat[i,j,p] := ABCmat[i,j,p] + ABCmat[i,j,k]; + end; + end; + end; + + // get 2-way interactions + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + sumABsqr := sumABsqr + (ABmat[i,j] * ABmat[i,j]); + sumACsqr := sumACsqr + (ACmat[i,j] * ACmat[i,j]); + sumBCsqr := SumBCsqr + (BCmat[i,j] * BCmat[i,j]); + ABmat[i,p] := ABmat[i,p] + ABmat[i,j]; + ABmat[p,j] := ABmat[p,j] + ABmat[i,j]; + ACmat[i,p] := ACmat[i,p] + ACmat[i,j]; + ACmat[p,j] := ACmat[p,j] + ACmat[i,j]; + BCmat[i,p] := BCmat[i,p] + BCmat[i,j]; + BCmat[p,j] := BCmat[p,j] + BCmat[i,j]; + for k := 0 to p-1 do + sumABCsqr := sumABCsqr + (ABCmat[i,j,k] * ABCmat[i,j,k]); + end; + end; + for i := 0 to p-1 do + begin + sumAsqr := sumAsqr + (Atotals[i] * Atotals[i]); + sumBsqr := sumBsqr + (Btotals[i] * Btotals[i]); + SumCsqr := sumCsqr + (Ctotals[i] * Ctotals[i]); + sumDsqr := sumDsqr + (Dtotals[i] * Dtotals[i]); + end; + + G := GrandMean; + term1 := (G * G) / (n * p * p * p); + term2 := sumxsqr; + term3 := sumAsqr / (n * p * p); + term4 := sumBsqr / (n * p * p); + term5 := sumCsqr / (n * p * p); + term9 := sumDsqr / (n * p * p); + term6 := sumABsqr / (n * p); + term7 := SumACsqr / (n * p); + term8 := SumBCsqr / (n * p); + term10 := sumABCsqr / n; + SSA := term3 - term1; + SSB := term4 - term1; + SSC := term5 - term1; + SSD := term9 - term1; + SSAB := term6 - term3 - term4 + term1; + SSAC := term7 - term3 - term5 + term1; + SSBC := term8 - term4 - term5 + term1; + SSABC := term10 - term6 - term7 - term8 + term3 + term4 + term5 - term1; + SSABC := SSABC - (term9 - term1); + + // get ss within + for i := 0 to p - 1 do + for j := 0 to p - 1 do + for k := 0 to p - 1 do + for m := 0 to p - 1 do + SSwithin := SSwithin + (celltotals[i,j,k,m] * celltotals[i,j,k,m]); + SSwithin := sumXsqr - (SSwithin / n); + + // get SS residual + SStotal := sumXsqr - term1; + dfa := p-1; + dfb := p-1; + dfc := p-1; + dfd := p-1; + dfab := (p - 1) * (p - 1); + dfac := dfab; + dfbc := dfab; + dfabc := ( (p-1) * (p-1) * (p-1) ) - (p-1); + dfwithin := p * p * p * (n - 1); + dftotal := n * p * p * p - 1; + MSa := SSA / dfa; + MSb := SSB / dfb; + MSc := SSC / dfc; + MSd := SSD / dfd; + MSab := SSAB / dfab; + MSac := SSAC / dfac; + MSbc := SSBC / dfbc; + MSabc := SSABC / dfabc; +// MSres := SSres / dfres; + MSwithin := SSwithin / dfwithin; + fa := MSa / MSwithin; + fb := MSb / MSwithin; + fc := MSc / MSwithin; + fd := MSd / MSwithin; + fab := MSab / MSwithin; + fac := MSac / MSwithin; + fbc := MSbc / MSwithin; + fabc := MSabc / MSwithin; + proba := probf(fa,dfa,dfwithin); + probb := probf(fb,dfb,dfwithin); + probc := probf(fc,dfc,dfwithin); + probd := probf(fd,dfd,dfwithin); + probab := probf(fab,dfab,dfwithin); + probac := probf(fac,dfac,dfwithin); + probbc := probf(fbc,dfbc,dfwithin); + probabc := probf(fabc,dfabc,dfwithin); + + // show ANOVA table results + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Latin Square Analysis Plan 3 Results'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + OutputFrm.RichEdit.Lines.Add('Source SS DF MS F Prob.>F'); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + cellstring := 'Factor A '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSA,dfa,MSa,fa,proba]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Factor B '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSB,dfb,MSb,fb,probb]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Factor C '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSC,dfc,MSc,fc,probc]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Factor D '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSD,dfd,MSd,fd,probd]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'A x B '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSAB,dfab,MSab,fab,probab]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'A x C '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSAC,dfac,MSac,fac,probac]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'B x C '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSBC,dfbc,MSbc,fbc,probbc]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'A x B x C '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSABC,dfabc,MSabc,fabc,probabc]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Within '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f',[SSwithin, dfwithin, MSwithin]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Total '; + cellstring := cellstring + format('%9.3f %9.0f',[SStotal, dftotal]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + + // show design for each block + for k := 0 to rangeD - 1 do + begin + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Experimental Design for block ' + format('%d',[k+1]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + slice := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + block := StrToInt(OS3MainFrm.DataGrid.Cells[Dcol,i]); + if block = minD + k then + Design[row-1,col-1] := 'C' + IntToStr(slice); + end; + for i := 0 to p - 1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + begin + cellstring := cellstring + format('%5s',[Design[i,j]]); + end; + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + + // get cell means + for i := 0 to p-1 do + for j := 0 to p-1 do + for k := 0 to p - 1 do + for m := 0 to p - 1 do + celltotals[i,j,k,m] := celltotals[i,j,k,m] / n; + for i := 0 to p-1 do + begin + for j := 0 to p - 1 do + begin + for k := 0 to p - 1 do + begin + for m := 0 to p - 1 do + begin + celltotals[p,j,k,m] := celltotals[p,j,k,m] / (p * n); + celltotals[i,p,k,m] := celltotals[i,p,k,m] / (p * n); + celltotals[i,j,p,m] := celltotals[i,j,p,m] / (p * n); + celltotals[i,j,k,p] := celltotals[i,j,k,p] / (p * n); + end; + end; + end; + end; + for i := 0 to p-1 do + for j := 0 to p-1 do + for k := 0 to p-1 do + ABCmat[i,j,k] := ABCmat[i,j,k] / n; + for j := 0 to p-1 do + for k := 0 to p-1 do + ABCmat[p,j,k] := ABCmat[p,j,k] / (p * n); + for i := 0 to p-1 do + for k := 0 to p-1 do + ABCmat[i,p,k] := ABCmat[i,p,k] / (p * n); + for i := 0 to p - 1 do + for j := 0 to p - 1 do + ABCmat[i,j,p] := ABCmat[i,j,p] / (p * n); + + GrandMean := GrandMean / (p * p * p * n ); + for i := 0 to p-1 do + begin + Atotals[i] := Atotals[i] / (p * p * n); + Btotals[i] := Btotals[i] / (p * p * n); + Ctotals[i] := Ctotals[i] / (p * p * n); + Dtotals[i] := Dtotals[i] / (p * p * n); + end; + + // show table of means for each block + for k := 0 to p-1 do + begin + OutputFrm.RichEdit.Lines.Add(''); + cellstring := format('BLOCK %d',[k+1]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Cell means and totals'); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 0 to p-1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[ABCmat[i,j,k]]); + end; + cellstring := cellstring + format(' %8.3f ',[ABCmat[i,p,k]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := 'Total '; + for j := 0 to p-1 do + cellstring := cellstring + format(' %8.3f ',[ABCmat[p,j,k]]); + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + + // show category means + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Means for each variable'); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Atotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Btotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorC]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Ctotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorD]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Dtotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.ShowModal; + +cleanup: + Design := nil; + Dtotals := nil; + Ctotals := nil; + Btotals := nil; + Atotals := nil; + ABmat := nil; + ACmat := nil; + BCmat := nil; + ABCmat := nil; + celltotals := nil; + cellcnts := nil; +end; + +procedure TLatinSqrsFrm.Plan4(Sender: TObject); +label cleanup; +var + NoFactors : integer; + n : integer; // no. of subjects per cell + Acol, Bcol, Ccol, Dcol, DataCol : integer; // variable columns in grid + FactorA : string; + FactorB : string; + FactorC : string; + FactorD : string; + DataVar : string; + cellstring : string; + i, j, k, minA, minB, minC, maxA, maxB, maxC : integer; + minD, maxD, rangeA, rangeB, rangeC, rangeD : integer; + value : integer; + cellcnts : IntDyneMat; + ABmat : DblDyneMat; + ABCmat : DblDyneCube; + Atotals : DblDyneVec; + Btotals : DblDyneVec; + Ctotals : DblDyneVec; + Dtotals : DblDyneVec; + design : StrDyneMat; + G, term1, term2, term3, term4, term5, term6, term7 : double; + sumxsqr : double; + sumAsqr, sumBsqr, sumCsqr, sumDsqr, SSA, SSB, SSC, SSD : double; + SSwithin, SSres, SStotal : double; + MSa, MSb, MSc, MSd, MSres, MSwithin : double; + data, GrandMean : double; + p, row, col, slice, block : integer; + dfa, dfb, dfc, dfres, dfwithin, dftotal, fa, fb, fc : double; + dfd, fd, fres : double; + proba, probb, probc, probd, probres : double; + +begin + NoFactors := 4; + LatinSpecsFrm.PanelD.Visible := true; + LatinSpecsFrm.PanelGrp.Visible := false; + LatinSpecsFrm.AinBtn.Enabled := true; + LatinSpecsFrm.AoutBtn.Enabled := false; + LatinSpecsFrm.BinBtn.Enabled := true; + LatinSpecsFrm.BoutBtn.Enabled := false; + LatinSpecsFrm.CinBtn.Enabled := true; + LatinSpecsFrm.CoutBtn.Enabled := false; +// LatinSpecsFrm.DCodeEdit.Visible := true; + LatinSpecsFrm.ACodeEdit.Text := ''; + LatinSpecsFrm.BCodeEdit.Text := ''; + LatinSpecsFrm.CCodeEdit.Text := ''; + LatinSpecsFrm.DCodeEdit.Text := ''; + LatinSpecsFrm.GrpCodeEdit.Text := ''; + LatinSpecsFrm.DepVarEdit.Text := ''; + LatinSpecsFrm.nPerCellEdit.Text := ''; +// LatinSpecsFrm.GrpCodeEdit.Visible := false; +// LatinSpecsFrm.DCodeLabel.Visible := true; +// LatinSpecsFrm.GrpCodeLabel.Visible := false; +// LatinSpecsFrm.DinBtn.Visible := true; +// LatinSpecsFrm.DoutBtn.Visible := true; + LatinSpecsFrm.DinBtn.Enabled := true; + LatinSpecsFrm.DoutBtn.Enabled := false; +// LatinSpecsFrm.GrpInBtn.Visible := false; +// LatinSpecsFrm.GrpOutBtn.Visible := false; + LatinSpecsFrm.DataInBtn.Enabled := true; + LatinSpecsFrm.DataOutBtn.Enabled := false; + LatinSpecsFrm.ShowModal; + if LatinSpecsFrm.ModalResult = mrCancel then exit; + n := StrToInt(LatinSpecsFrm.nPerCellEdit.Text); + if n <= 0 then + begin + ShowMessage('Please specify the number of cases per cell.'); + exit; + end; + FactorA := LatinSpecsFrm.ACodeEdit.Text; + FactorB := LatinSpecsFrm.BCodeEdit.Text; + FactorC := LatinSpecsFrm.CCodeEdit.Text; + FactorD := LatinSpecsFrm.DCodeEdit.Text; + DataVar := LatinSpecsFrm.DepVarEdit.Text; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = FactorA) then ACol := i; + if (cellstring = FactorB) then BCol := i; + if (cellstring = FactorC) then Ccol := i; + if (cellstring = FactorD) then Dcol := i; + if (cellstring = DataVar) then DataCol := i; + end; + + // determine no. of levels in A, B and C + minA := 1000; + minB := 1000; + minC := 1000; + minD := 1000; + maxA := -1000; + maxB := -1000; + maxC := -1000; + maxD := -1000; + for i := 1 to NoCases do + begin + value := StrToInt(OS3MainFrm.DataGrid.Cells[ACol,i]); + if value < minA then minA := value; + if value > maxA then maxA := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[BCol,i]); + if value < minB then minB := value; + if value > maxB then maxB := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + if value < minC then minC := value; + if value > maxC then maxC := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Dcol,i]); + if value < minD then minD := value; + if value > maxD then maxD := value; + end; + rangeA := maxA - minA + 1; + rangeB := maxB - minB + 1; + rangeC := maxC - minC + 1; + rangeD := maxD - minD + 1; + + // check for squareness + if ( (rangeA <> rangeB) or (rangeA <> rangeC) or (rangeB <> rangeC) ) then + begin + ShowMessage('ERROR! In a Latin square the range of values should be equal for A,B and C!'); + exit; + end; + p := rangeA; + + // set up an array for cell counts and for cell sums and marginal sums + SetLength(ABmat,p+1,p+1); + SetLength(ABCmat,p+1,p+1,p+1); + SetLength(cellcnts,p+1,p+1); + SetLength(Atotals,p); + SetLength(Btotals,p); + SetLength(Ctotals,p); + SetLength(Dtotals,p); + SetLength(Design,p,p); + + for i := 0 to p do + for j := 0 to p do + for k := 0 to p do + ABCmat[i,j,k] := 0.0; + + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + cellcnts[i,j] := 0; + ABmat[i,j] := 0.0; + end; + end; + + for i := 0 to p-1 do + begin + Atotals[i] := 0.0; + Btotals[i] := 0.0; + Ctotals[i] := 0.0; + Dtotals[i] := 0.0; + end; + + G := 0.0; + sumxsqr := 0.0; + sumAsqr := 0.0; + sumBsqr := 0.0; + sumCsqr := 0.0; + sumDsqr := 0.0; + SSwithin := 0.0; + term1 := 0.0; + term2 := 0.0; + term3 := 0.0; + term4 := 0.0; + term5 := 0.0; + term6 := 0.0; + term7 := 0.0; + GrandMean := 0.0; + + // Read in the data + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + slice := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + block := StrToInt(OS3MainFrm.DataGrid.Cells[Dcol,i]); + data := StrToFloat(OS3MainFrm.DataGrid.Cells[DataCol,i]); + cellcnts[row-1,col-1] := cellcnts[row-1,col-1] + 1; + ABCmat[row-1,col-1,slice-1] := ABCmat[row-1,col-1,slice-1] + data; + Atotals[row-1] := Atotals[row-1] + data; + Btotals[col-1] := Btotals[col-1] + data; + Ctotals[slice-1] := Ctotals[slice-1] + data; + Dtotals[block-1] := Dtotals[block-1] + data; + sumxsqr := sumxsqr + (data * data); + GrandMean := GrandMean + data; + end; + + // collapse c's into a x b + for k := 0 to p-1 do + for i := 0 to p-1 do + for j := 0 to p-1 do + ABmat[i,j] := ABmat[i,j] + ABCmat[i,j,k]; + + // get sum of squared cells + for i := 0 to p - 1 do + for j := 0 to p - 1 do + SSwithin := SSwithin + (ABmat[i,j] * ABmat[i,j]); + + // check for equal cell counts + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + if cellcnts[i,j] <> n then + begin + ShowMessage('cell sizes are not equal!'); + goto cleanup; + end; + end; + end; + + for i := 0 to p-1 do + begin + sumAsqr := sumAsqr + (Atotals[i] * Atotals[i]); + sumBsqr := sumBsqr + (Btotals[i] * Btotals[i]); + sumCsqr := sumCsqr + (Ctotals[i] * Ctotals[i]); + sumDsqr := sumDsqr + (Dtotals[i] * Dtotals[i]); + end; + + G := GrandMean; + term1 := (G * G) / (n * p * p); + term2 := sumxsqr; + term3 := sumAsqr / (n * p); + term4 := sumBsqr / (n * p); + term5 := sumCsqr / (n * p); + term6 := sumDsqr / (n * p); + term7 := SSwithin / n; + SSA := term3 - term1; + SSB := term4 - term1; + SSC := term5 - term1; + SSD := term6 - term1; + SSres := term7 - term3 - term4 - term5 - term6 + (3 * term1); + SSwithin := term2 - term7; + SStotal := term2 - term1; + + dfa := p-1; + dfb := p-1; + dfc := p-1; + dfd := p-1; + dfres := (p-1) * (p-3); + dfwithin := p * p * (n - 1); + dftotal := n * p * p - 1; + MSa := SSA / dfa; + MSb := SSB / dfb; + MSc := SSC / dfc; + MSd := SSD / dfd; + if dfres > 0 then MSres := SSres / dfres; + MSwithin := SSwithin / dfwithin; + fa := MSa / MSwithin; + fb := MSb / MSwithin; + fc := MSc / MSwithin; + fd := MSd / MSwithin; + if dfres > 0 then fres := MSres / MSwithin; + proba := probf(fa,dfa,dfwithin); + probb := probf(fb,dfb,dfwithin); + probc := probf(fc,dfc,dfwithin); + probd := probf(fd,dfd,dfwithin); + if dfres > 0 then probres := probf(fres,dfres,dfwithin); + + // show ANOVA table results + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Greco-Latin Square Analysis (No Interactions)'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + OutputFrm.RichEdit.Lines.Add('Source SS DF MS F Prob.>F'); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + cellstring := 'Factor A '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSA,dfa,MSa,fa,proba]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Factor B '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSB,dfb,MSb,fb,probb]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Latin Sqr.'; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSC,dfc,MSc,fc,probc]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Greek Sqr.'; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSD,dfd,MSd,fd,probd]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Residual '; + if dfres > 0 then + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSres,dfres,MSres,fres,probres]) + else cellstring := cellstring + ' - - - - -'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Within '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f',[SSwithin, dfwithin, MSwithin]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Total '; + cellstring := cellstring + format('%9.3f %9.0f',[SStotal, dftotal]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + + // show design for Latin Square + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Experimental Design for Latin Square '; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + slice := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + Design[row-1,col-1] := 'C' + IntToStr(slice); + end; + for i := 0 to p - 1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + cellstring := cellstring + format('%5s',[Design[i,j]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + // show design for Greek Square + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Experimental Design for Greek Square '; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + block := StrToInt(OS3MainFrm.DataGrid.Cells[Dcol,i]); + Design[row-1,col-1] := 'C' + IntToStr(block); + end; + for i := 0 to p - 1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + cellstring := cellstring + format('%5s',[Design[i,j]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + for i := 0 to p-1 do + begin + for j := 0 to p - 1 do + begin + ABmat[i,p] := ABmat[i,p] + ABmat[i,j]; + ABmat[p,j] := ABmat[p,j] + ABmat[i,j]; + end; + end; + + for i := 0 to p-1 do + for j := 0 to p-1 do + ABmat[i,j] := ABmat[i,j] / n; + for i := 0 to p-1 do + ABmat[i,p] := ABmat[i,p] / (n * p); + for j := 0 to p-1 do + ABmat[p,j] := ABmat[p,j] / (n * p); + + GrandMean := GrandMean / (p * p * n ); + for i := 0 to p-1 do + begin + Atotals[i] := Atotals[i] / (p * n); + Btotals[i] := Btotals[i] / (p * n); + Ctotals[i] := Ctotals[i] / (p * n); + Dtotals[i] := Dtotals[i] / (p * n); + end; + + // show table of means for ABmat + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Cell means and totals'); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 0 to p-1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + cellstring := cellstring + format(' %8.3f ',[ABmat[i,j]]); + cellstring := cellstring + format(' %8.3f ',[ABmat[i,p]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := 'Total '; + for j := 0 to p-1 do + cellstring := cellstring + format(' %8.3f ',[ABmat[p,j]]); + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + // show category means + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Means for each variable'); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Atotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Btotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorC]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Ctotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to rangeD + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorD]); + for i := 1 to rangeD do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to rangeD + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to rangeD - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Dtotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to rangeD + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.ShowModal; + +cleanup: + Design := nil; + Dtotals := nil; + Ctotals := nil; + Btotals := nil; + Atotals := nil; + cellcnts := nil; + ABCmat := nil; + ABmat := nil; +end; + +procedure TLatinSqrsFrm.Plan5(Sender: TObject); +label cleanup; +var + NoFactors : integer; + n : integer; // no. of subjects per cell + Acol, Bcol, SbjCol, Grpcol, DataCol : integer; // variable columns in grid + FactorA : string; + FactorB : string; + SubjectFactor : string; + GroupFactor : string; + DataVar : string; + cellstring : string; + i, j, k, minA, minB, minGrp, maxA, maxB, maxGrp : integer; + rangeA, rangeB, rangeGrp : integer; + value : integer; + cellcnts : IntDyneMat; + ABmat : DblDyneMat; + ABCmat : DblDyneCube; + GBmat : DblDyneMat; + Atotals : DblDyneVec; + Btotals : DblDyneVec; + Grptotals : DblDyneVec; + Subjtotals : DblDyneMat; + design : StrDyneMat; + G, term1, term2, term3, term4, term5, term6, term7 : double; + sumxsqr : double; + SSbetsubj, SSgroups, SSsubwGrps, SSwithinsubj, SSa, SSb, SSab : double; + SSerrwithin, SStotal, MSgroups, MSsubwGrps, MSa, MSb, MSab : double; + MSerrwithin, DFbetsubj, DFgroups, DFsubwGrps, DFwithinsubj : double; + DFa, DFb, DFab, DFerrwithin, DFtotal : double; + data, GrandMean : double; + p, row, col, subject, group : integer; + proba, probb, probab, probgrps : double; + fa, fb, fab, fgroups : double; + RowLabels, ColLabels : StrDyneVec; + Title : string; + +begin + NoFactors := 3; + LatinSpecsFrm.PanelD.Visible := false; + LatinSpecsFrm.PanelGrp.Visible := true; + LatinSpecsFrm.AinBtn.Enabled := true; + LatinSpecsFrm.AoutBtn.Enabled := false; + LatinSpecsFrm.BinBtn.Enabled := true; + LatinSpecsFrm.BoutBtn.Enabled := false; + LatinSpecsFrm.CinBtn.Enabled := true; + LatinSpecsFrm.CoutBtn.Enabled := false; +// LatinSpecsFrm.DCodeEdit.Visible := false; + LatinSpecsFrm.ACodeEdit.Text := ''; + LatinSpecsFrm.BCodeEdit.Text := ''; + LatinSpecsFrm.CCodeEdit.Text := ''; + LatinSpecsFrm.DCodeEdit.Text := ''; + LatinSpecsFrm.GrpCodeEdit.Text := ''; + LatinSpecsFrm.DepVarEdit.Text := ''; + LatinSpecsFrm.nPerCellEdit.Text := ''; +// LatinSpecsFrm.GrpCodeEdit.Visible := true; +// LatinSpecsFrm.DCodeLabel.Visible := false; +// LatinSpecsFrm.GrpCodeLabel.Visible := true; +// LatinSpecsFrm.DinBtn.Visible := false; +// LatinSpecsFrm.DoutBtn.Visible := false; +// LatinSpecsFrm.GrpInBtn.Visible := true; +// LatinSpecsFrm.GrpOutBtn.Visible := true; + LatinSpecsFrm.GrpInBtn.Enabled := true; + LatinSpecsFrm.GrpOutBtn.Enabled := false; + LatinSpecsFrm.DataInBtn.Enabled := true; + LatinSpecsFrm.DataOutBtn.Enabled := false; + LatinSpecsFrm.ShowModal; + if LatinSpecsFrm.ModalResult = mrCancel then exit; + n := StrToInt(LatinSpecsFrm.nPerCellEdit.Text); + if n <= 0 then + begin + ShowMessage('Please specify the number of cases per cell.'); + exit; + end; + FactorA := LatinSpecsFrm.ACodeEdit.Text; + FactorB := LatinSpecsFrm.BCodeEdit.Text; + SubjectFactor := LatinSpecsFrm.CCodeEdit.Text; + GroupFactor := LatinSpecsFrm.GrpCodeEdit.Text; + DataVar := LatinSpecsFrm.DepVarEdit.Text; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = FactorA) then ACol := i; + if (cellstring = FactorB) then BCol := i; + if (cellstring = GroupFactor) then Grpcol := i; + if (cellstring = SubjectFactor) then Sbjcol := i; + if (cellstring = DataVar) then DataCol := i; + end; + + // determine no. of levels in A, B and Group + minA := 1000; + minB := 1000; + minGrp := 1000; + maxA := -1000; + maxB := -1000; + maxGrp := -1000; + for i := 1 to NoCases do + begin + value := StrToInt(OS3MainFrm.DataGrid.Cells[ACol,i]); + if value < minA then minA := value; + if value > maxA then maxA := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[BCol,i]); + if value < minB then minB := value; + if value > maxB then maxB := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Grpcol,i]); + if value < minGrp then minGrp := value; + if value > maxGrp then maxGrp := value; + end; + rangeA := maxA - minA + 1; + rangeB := maxB - minB + 1; + rangeGrp := maxGrp - minGrp + 1; + + // check for squareness + if (rangeA <> rangeGrp) then + begin + ShowMessage('ERROR! In a Latin square the range of values should be equal for A,B and C!'); + exit; + end; + p := rangeA; + + // set up an array for cell counts and for cell sums and marginal sums + SetLength(ABmat,p+1,p+1); + SetLength(ABCmat,p+1,p+1,n+1); + SetLength(cellcnts,p+1,p+1); + SetLength(Atotals,p+1); + SetLength(Btotals,p+1); + SetLength(Grptotals,p+1); + SetLength(Design,p,p); + SetLength(Subjtotals,p+1,n+1); + SetLength(RowLabels,p+1); + SetLength(ColLabels,n+1); + SetLength(GBmat,p+1,p+1); + + for i := 0 to p-1 do + begin + RowLabels[i] := IntToStr(i+1); + ColLabels[i] := RowLabels[i]; + end; + RowLabels[p] := 'Total'; + ColLabels[p] := 'Total'; + + for i := 0 to p do + for j := 0 to p do + for k := 0 to n do + ABCmat[i,j,k] := 0.0; + + for i := 0 to p do + begin + for j := 0 to p do + begin + cellcnts[i,j] := 0; + ABmat[i,j] := 0.0; + GBmat[i,j] := 0.0; + end; + end; + + for i := 0 to p do + begin + Atotals[i] := 0.0; + Btotals[i] := 0.0; + Grptotals[i] := 0.0; + end; + + for i := 0 to p do + for j := 0 to n do + Subjtotals[i,j] := 0.0; + + G := 0.0; + sumxsqr := 0.0; + term1 := 0.0; + term2 := 0.0; + term3 := 0.0; + term4 := 0.0; + term5 := 0.0; + term6 := 0.0; + term7 := 0.0; + GrandMean := 0.0; + + // Read in the data + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + group := StrToInt(OS3MainFrm.DataGrid.Cells[Grpcol,i]); + subject := StrToInt(OS3MainFrm.DataGrid.Cells[Sbjcol,i]); + data := StrToFloat(OS3MainFrm.DataGrid.Cells[DataCol,i]); + cellcnts[group-1,row-1] := cellcnts[group-1,row-1] + 1; + ABCmat[group-1,row-1,subject-1] := ABCmat[group-1,row-1,subject-1] + data; + Subjtotals[group-1,subject-1] := Subjtotals[group-1,subject-1] + data; + GBmat[group-1,col-1] := GBmat[group-1,col-1] + data; + Atotals[col-1] := Atotals[col-1] + data; + Btotals[group-1] := Btotals[group-1] + data; + Grptotals[group-1] := Grptotals[group-1] + data; + sumxsqr := sumxsqr + (data * data); + GrandMean := GrandMean + data; + end; + + // check for equal cell counts + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + if cellcnts[i,j] <> n then + begin + ShowMessage('cell sizes are not equal!'); + goto cleanup; + end; + end; + end; + + // collapse subjects's into group x a matrix + for i := 0 to p-1 do // group + for j := 0 to p-1 do // factor a + for k := 0 to n-1 do // subject + ABmat[i,j] := ABmat[i,j] + ABCmat[i,j,k]; + + // get marginal totals for ABmat and GBmat + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + ABmat[p,j] := ABmat[p,j] + ABmat[i,j]; + ABmat[i,p] := ABmat[i,p] + ABmat[i,j]; + GBmat[p,j] := GBmat[p,j] + GBmat[i,j]; + GBmat[i,p] := GBmat[i,p] + GBmat[i,j]; + end; + end; + + // get grand total for ABmat and GBmat + for i := 0 to p-1 do + begin + ABmat[p,p] := ABmat[p,p] + ABmat[p,i]; + GBmat[p,p] := GBmat[p,p] + GBmat[p,i]; + end; + + // Get marginal totals for Subjtotals + for i := 0 to p-1 do + begin + for j := 0 to n-1 do + begin + Subjtotals[p,j] := Subjtotals[p,j] + Subjtotals[i,j]; + Subjtotals[i,n] := Subjtotals[i,n] + Subjtotals[i,j]; + end; + end; + for i := 0 to p-1 do Subjtotals[p,n] := Subjtotals[p,n] + Subjtotals[i,n]; + // test block + OutputFrm.RichEdit.Lines.Add('Sums for ANOVA Analysis'); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Group (rows) times A Factor (columns) sums'; + MAT_PRINT(ABmat,p+1,p+1,cellstring,RowLabels,ColLabels,(n*p*p)); + cellstring := 'Group (rows) times B (cells Factor) sums'; + MAT_PRINT(GBmat,p+1,p+1,cellstring,RowLabels,ColLabels,(n*p*p)); + Title := 'Groups (rows) times Subjects (columns) matrix'; + for i := 0 to n-1 do ColLabels[i] := IntToStr(i+1); + ColLabels[n] := 'Total'; + Mat_Print(Subjtotals,p+1,n+1,Title,RowLabels,ColLabels,(n*p*p)); + OutputFrm.ShowModal; + + // get squared sum of subject's totals in each group + for i := 0 to p-1 do // group + term7 := term7 + (Subjtotals[i,n] * Subjtotals[i,n]); + term7 := term7 / (n*p); // Sum G^2 sub k + + // now square each person score in each group and get sum for group + for i := 0 to p-1 do + for j := 0 to n-1 do + Subjtotals[i,j] := Subjtotals[i,j] * Subjtotals[i,j]; + for i := 0 to p-1 do Subjtotals[i,n] := 0.0; + for i := 0 to p-1 do + for j := 0 to n-1 do + Subjtotals[i,n] := Subjtotals[i,n] + Subjtotals[i,j]; + for i := 0 to p-1 do term6 := term6 + Subjtotals[i,n]; + SSsubwgrps := term6 / p - term7; + + // get correction term + term1 := (GrandMean * GrandMean) / (n * p * p); + + term2 := sumxsqr; + + // get sum of squared a's for term3 + for j := 0 to p-1 do + term3 := term3 + (ABmat[p,j] * ABmat[p,j]); + term3 := term3 / (n * p); + + // get sum of squared groups for term4 + for i := 0 to p-1 do + term4 := term4 + (ABmat[i,p] * ABmat[i,p]); + term4 := term4 / (n * p); + + // get squared sum of b's (across groups) for term5 + for j := 0 to p-1 do + term5 := term5 + (GBmat[p,j] * GBmat[p,j]); + term5 := term5 / (n * p); + + SSgroups := term4 - term1; + SSbetsubj := SSgroups + SSsubwgrps; + SStotal := sumxsqr - term1; + SSwithinsubj := SStotal - SSbetsubj; + SSa := term3 - term1; + SSb := term5 - term1; + + // get sum of squared AB cells for term6 + term6 := 0.0; + for i := 0 to p-1 do + for j := 0 to p-1 do + term6 := term6 + (ABmat[i,j] * ABmat[i,j]); + term6 := term6 / n; + SSab := term6 - term3 - term5 + term1; + SSab := SSab - SSgroups; + SSerrwithin := ( sumxsqr - term6) - SSsubwgrps; + + // record degrees of freedom for sources + dfbetsubj := n * p - 1; + dfsubwgrps := p * (n-1); + dfgroups := p - 1; + dftotal := n * p * p - 1; + dfwithinsubj := n * p * (p-1); + dfa := p - 1; + dfb := p - 1; + dfab := (p - 1) * (p - 2); + dferrwithin := p * (n - 1) * (p - 1); + + MSsubwgrps := SSsubwgrps / dfsubwgrps; + MSgroups := SSgroups / dfgroups; + MSa := SSa / dfa; + MSb := SSb / dfb; + MSab := SSab / dfab; + MSerrwithin := SSerrwithin / dferrwithin; + fgroups := MSgroups / MSsubwgrps; + fa := MSa / MSerrwithin; + fb := MSb / MSerrwithin; + fab := MSab / MSerrwithin; + probgrps := probf(fgroups,dfgroups,dfsubwgrps); + proba := probf(fa,dfa,dferrwithin); + probb := probf(fb,dfb,dferrwithin); + probab := probf(fab,dfab,dferrwithin); + + // show ANOVA table results + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Latin Squares Repeated Analysis Plan 5 (Partial Interactions)'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + OutputFrm.RichEdit.Lines.Add('Source SS DF MS F Prob.>F'); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + cellstring := 'Betw.Subj.'; + cellstring := cellstring + format('%9.3f %9.0f',[SSbetsubj,dfbetsubj]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Groups '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSgroups,dfgroups,MSgroups,fgroups,probgrps]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Subj.w.g.'; + cellstring := cellstring + format('%9.3f %9.0f %9.3f',[SSsubwgrps,dfsubwgrps,MSsubwgrps]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Within Sub'; + cellstring := cellstring + format('%9.3f %9.0f',[SSwithinsubj,dfwithinsubj]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor A '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSa,dfa,MSa,fa,proba]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor B '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSb,dfb,MSb,fb,probb]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor AB'; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSab,dfab,MSab,fab,probab]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Error w. '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f',[SSerrwithin,dferrwithin,MSerrwithin]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Total '; + cellstring := cellstring + format('%9.3f %9.0f',[SStotal, dftotal]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + + // show design for Square + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Experimental Design for Latin Square '; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[GroupFactor]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); // A (column) effect + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); // B (cell) effect + group := StrToInt(OS3MainFrm.DataGrid.Cells[Grpcol,i]); // group (row) + Design[group-1,row-1] := 'B' + IntToStr(col); + end; + for i := 0 to p - 1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + cellstring := cellstring + format('%5s',[Design[i,j]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + for i := 0 to p-1 do + for j := 0 to p-1 do + ABmat[i,j] := ABmat[i,j] / n; + for i := 0 to p-1 do + ABmat[i,p] := ABmat[i,p] / (n * p); + for j := 0 to p-1 do + ABmat[p,j] := ABmat[p,j] / (n * p); + + GrandMean := GrandMean / (p * p * n ); + for i := 0 to p-1 do + begin + Atotals[i] := Atotals[i] / (p * n); + Btotals[i] := Btotals[i] / (p * n); + Grptotals[i] := Grptotals[i] / (p * n); +// Dtotals[i] := Dtotals[i] / (p * n); + end; + + // show table of means for ABmat + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Cell means and totals'); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[GroupFactor]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 0 to p-1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + cellstring := cellstring + format(' %8.3f ',[ABmat[i,j]]); + cellstring := cellstring + format(' %8.3f ',[ABmat[i,p]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := 'Total '; + for j := 0 to p-1 do + cellstring := cellstring + format(' %8.3f ',[ABmat[p,j]]); + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + // show category means + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Means for each variable'); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Atotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Btotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[GroupFactor]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Grptotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.ShowModal; + +cleanup: + GBmat := nil; + ColLabels := nil; + RowLabels := nil; + Subjtotals := nil; + Design := nil; + Grptotals := nil; + Btotals := nil; + Atotals := nil; + cellcnts := nil; + ABCmat := nil; + ABmat := nil; +end; + +procedure TLatinSqrsFrm.Plan6(Sender: TObject); +label cleanup; +var + NoFactors : integer; + n : integer; // no. of subjects per cell + Acol, Bcol, SbjCol, Grpcol, DataCol : integer; // variable columns in grid + FactorA : string; + FactorB : string; + SubjectFactor : string; + GroupFactor : string; + DataVar : string; + cellstring : string; + i, j, k, minA, minB, minGrp, maxA, maxB, maxGrp : integer; + rangeA, rangeB, rangeGrp : integer; + value : integer; + cellcnts : IntDyneMat; + ABmat : DblDyneMat; + ABCmat : DblDyneCube; + GBmat : DblDyneMat; + Atotals : DblDyneVec; + Btotals : DblDyneVec; + Grptotals : DblDyneVec; + Subjtotals : DblDyneMat; + design : StrDyneMat; + G, term1, term2, term3, term4, term5, term6, term7 : double; + sumxsqr : double; + SSbetsubj, SSgroups, SSsubwGrps, SSwithinsubj, SSa, SSb, SSab : double; + SSerrwithin, SStotal, MSgroups, MSsubwGrps, MSa, MSb, MSab : double; + MSerrwithin, DFbetsubj, DFgroups, DFsubwGrps, DFwithinsubj : double; + DFa, DFb, DFab, DFerrwithin, DFtotal : double; + data, GrandMean : double; + p, row, col, subject, group : integer; + proba, probb, probab, probgrps : double; + fa, fb, fab, fgroups : double; + RowLabels, ColLabels : StrDyneVec; + Title : string; + +begin + NoFactors := 3; + LatinSpecsFrm.PanelD.Visible := false; + LatinSpecsFrm.PanelGrp.Visible := true; + LatinSpecsFrm.AinBtn.Enabled := true; + LatinSpecsFrm.AoutBtn.Enabled := false; + LatinSpecsFrm.BinBtn.Enabled := true; + LatinSpecsFrm.BoutBtn.Enabled := false; + LatinSpecsFrm.CinBtn.Enabled := true; + LatinSpecsFrm.CoutBtn.Enabled := false; +// LatinSpecsFrm.DCodeEdit.Visible := false; + LatinSpecsFrm.ACodeEdit.Text := ''; + LatinSpecsFrm.BCodeEdit.Text := ''; + LatinSpecsFrm.CCodeEdit.Text := ''; + LatinSpecsFrm.DCodeEdit.Text := ''; + LatinSpecsFrm.GrpCodeEdit.Text := ''; + LatinSpecsFrm.DepVarEdit.Text := ''; + LatinSpecsFrm.nPerCellEdit.Text := ''; +// LatinSpecsFrm.GrpCodeEdit.Visible := true; +// LatinSpecsFrm.DCodeLabel.Visible := false; +// LatinSpecsFrm.GrpCodeLabel.Visible := true; +// LatinSpecsFrm.DinBtn.Visible := false; +// LatinSpecsFrm.DoutBtn.Visible := false; +// LatinSpecsFrm.GrpInBtn.Visible := true; +// LatinSpecsFrm.GrpOutBtn.Visible := true; + LatinSpecsFrm.GrpInBtn.Enabled := true; + LatinSpecsFrm.GrpOutBtn.Enabled := false; + LatinSpecsFrm.DataInBtn.Enabled := true; + LatinSpecsFrm.DataOutBtn.Enabled := false; + LatinSpecsFrm.ShowModal; + if LatinSpecsFrm.ModalResult = mrCancel then exit; + n := StrToInt(LatinSpecsFrm.nPerCellEdit.Text); + if n <= 0 then + begin + ShowMessage('Please specify the number of cases per cell.'); + exit; + end; + FactorA := LatinSpecsFrm.ACodeEdit.Text; + FactorB := LatinSpecsFrm.BCodeEdit.Text; + SubjectFactor := LatinSpecsFrm.CCodeEdit.Text; + GroupFactor := LatinSpecsFrm.GrpCodeEdit.Text; + DataVar := LatinSpecsFrm.DepVarEdit.Text; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = FactorA) then ACol := i; + if (cellstring = FactorB) then BCol := i; + if (cellstring = GroupFactor) then Grpcol := i; + if (cellstring = SubjectFactor) then Sbjcol := i; + if (cellstring = DataVar) then DataCol := i; + end; + + // determine no. of levels in A, B and Group + minA := 1000; + minB := 1000; + minGrp := 1000; + maxA := -1000; + maxB := -1000; + maxGrp := -1000; + for i := 1 to NoCases do + begin + value := StrToInt(OS3MainFrm.DataGrid.Cells[ACol,i]); + if value < minA then minA := value; + if value > maxA then maxA := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[BCol,i]); + if value < minB then minB := value; + if value > maxB then maxB := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Grpcol,i]); + if value < minGrp then minGrp := value; + if value > maxGrp then maxGrp := value; + end; + rangeA := maxA - minA + 1; + rangeB := maxB - minB + 1; + rangeGrp := maxGrp - minGrp + 1; + + // check for squareness + if (rangeA <> rangeGrp) then + begin + ShowMessage('ERROR! In a Latin square the range of values should be equal for A,B and C!'); + exit; + end; + p := rangeA; + + // set up an array for cell counts and for cell sums and marginal sums + SetLength(ABmat,p+1,p+1); + SetLength(ABCmat,p+1,p+1,n+1); + SetLength(cellcnts,p+1,p+1); + SetLength(Atotals,p+1); + SetLength(Btotals,p+1); + SetLength(Grptotals,p+1); + SetLength(Design,p,p); + SetLength(Subjtotals,p+1,n+1); + SetLength(RowLabels,p+1); + SetLength(ColLabels,n+1); + SetLength(GBmat,p+1,p+1); + + for i := 0 to p-1 do + begin + RowLabels[i] := IntToStr(i+1); + ColLabels[i] := RowLabels[i]; + end; + RowLabels[p] := 'Total'; + ColLabels[p] := 'Total'; + + for i := 0 to p do + for j := 0 to p do + for k := 0 to n do + ABCmat[i,j,k] := 0.0; + + for i := 0 to p do + begin + for j := 0 to p do + begin + cellcnts[i,j] := 0; + ABmat[i,j] := 0.0; + GBmat[i,j] := 0.0; + end; + end; + + for i := 0 to p do + begin + Atotals[i] := 0.0; + Btotals[i] := 0.0; + Grptotals[i] := 0.0; + end; + + for i := 0 to p do + for j := 0 to n do + Subjtotals[i,j] := 0.0; + + G := 0.0; + sumxsqr := 0.0; + term1 := 0.0; + term2 := 0.0; + term3 := 0.0; + term4 := 0.0; + term5 := 0.0; + term6 := 0.0; + term7 := 0.0; + GrandMean := 0.0; + + // Read in the data + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + group := StrToInt(OS3MainFrm.DataGrid.Cells[Grpcol,i]); + subject := StrToInt(OS3MainFrm.DataGrid.Cells[Sbjcol,i]); + data := StrToFloat(OS3MainFrm.DataGrid.Cells[DataCol,i]); + cellcnts[group-1,row-1] := cellcnts[group-1,row-1] + 1; + ABCmat[group-1,row-1,subject-1] := ABCmat[group-1,row-1,subject-1] + data; + Subjtotals[group-1,subject-1] := Subjtotals[group-1,subject-1] + data; + GBmat[group-1,col-1] := GBmat[group-1,col-1] + data; + Atotals[col-1] := Atotals[col-1] + data; + Btotals[group-1] := Btotals[group-1] + data; + Grptotals[group-1] := Grptotals[group-1] + data; + sumxsqr := sumxsqr + (data * data); + GrandMean := GrandMean + data; + end; + + // check for equal cell counts + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + if cellcnts[i,j] <> n then + begin + ShowMessage('cell sizes are not equal!'); + goto cleanup; + end; + end; + end; + + // collapse subjects's into group x a matrix + for i := 0 to p-1 do // group + for j := 0 to p-1 do // factor a + for k := 0 to n-1 do // subject + ABmat[i,j] := ABmat[i,j] + ABCmat[i,j,k]; + + // get marginal totals for ABmat and GBmat + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + ABmat[p,j] := ABmat[p,j] + ABmat[i,j]; + ABmat[i,p] := ABmat[i,p] + ABmat[i,j]; + GBmat[p,j] := GBmat[p,j] + GBmat[i,j]; + GBmat[i,p] := GBmat[i,p] + GBmat[i,j]; + end; + end; + + // get grand total for ABmat and GBmat + for i := 0 to p-1 do + begin + ABmat[p,p] := ABmat[p,p] + ABmat[p,i]; + GBmat[p,p] := GBmat[p,p] + GBmat[p,i]; + end; + + // Get marginal totals for Subjtotals + for i := 0 to p-1 do + begin + for j := 0 to n-1 do + begin + Subjtotals[p,j] := Subjtotals[p,j] + Subjtotals[i,j]; + Subjtotals[i,n] := Subjtotals[i,n] + Subjtotals[i,j]; + end; + end; + for i := 0 to p-1 do Subjtotals[p,n] := Subjtotals[p,n] + Subjtotals[i,n]; + + // test block + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Latin Squares Repeated Analysis Plan 6'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Sums for ANOVA Analysis'); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Group - C (rows) times A Factor (columns) sums'; + MAT_PRINT(ABmat,p+1,p+1,cellstring,RowLabels,ColLabels,(n*p*p)); + cellstring := 'Group - C (rows) times B (cells Factor) sums'; + MAT_PRINT(GBmat,p+1,p+1,cellstring,RowLabels,ColLabels,(n*p*p)); + Title := 'Group - C (rows) times Subjects (columns) matrix'; + for i := 0 to n-1 do ColLabels[i] := IntToStr(i+1); + ColLabels[n] := 'Total'; + Mat_Print(Subjtotals,p+1,n+1,Title,RowLabels,ColLabels,(n*p*p)); + OutputFrm.ShowModal; + + // get squared sum of subject's totals in each group + for i := 0 to p-1 do // group + term7 := term7 + (Subjtotals[i,n] * Subjtotals[i,n]); + term7 := term7 / (n*p); // Sum G^2 sub k + + // now square each person score in each group and get sum for group + for i := 0 to p-1 do + for j := 0 to n-1 do + Subjtotals[i,j] := Subjtotals[i,j] * Subjtotals[i,j]; + for i := 0 to p-1 do Subjtotals[i,n] := 0.0; + for i := 0 to p-1 do + for j := 0 to n-1 do + Subjtotals[i,n] := Subjtotals[i,n] + Subjtotals[i,j]; + for i := 0 to p-1 do term6 := term6 + Subjtotals[i,n]; + SSsubwgrps := term6 / p - term7; + + // get correction term + term1 := (GrandMean * GrandMean) / (n * p * p); + + term2 := sumxsqr; + + // get sum of squared a's for term3 + for j := 0 to p-1 do + term3 := term3 + (ABmat[p,j] * ABmat[p,j]); + term3 := term3 / (n * p); + + // get sum of squared groups for term4 + for i := 0 to p-1 do + term4 := term4 + (ABmat[i,p] * ABmat[i,p]); + term4 := term4 / (n * p); + + // get squared sum of b's (across groups) for term5 + for j := 0 to p-1 do + term5 := term5 + (GBmat[p,j] * GBmat[p,j]); + term5 := term5 / (n * p); + + SSgroups := term4 - term1; + SSbetsubj := SSgroups + SSsubwgrps; + SStotal := sumxsqr - term1; + SSwithinsubj := SStotal - SSbetsubj; + SSa := term3 - term1; + SSb := term5 - term1; + + // get sum of squared AB cells for term6 + term6 := 0.0; + for i := 0 to p-1 do + for j := 0 to p-1 do + term6 := term6 + (ABmat[i,j] * ABmat[i,j]); + term6 := term6 / n; + SSab := term6 - term3 - term5 + term1; + SSab := SSab - SSgroups; + SSerrwithin := ( sumxsqr - term6) - SSsubwgrps; + + // record degrees of freedom for sources + dfbetsubj := n * p - 1; + dfsubwgrps := p * (n-1); + dfgroups := p - 1; + dftotal := n * p * p - 1; + dfwithinsubj := n * p * (p-1); + dfa := p - 1; + dfb := p - 1; + dfab := (p - 1) * (p - 2); + dferrwithin := p * (n - 1) * (p - 1); + + MSsubwgrps := SSsubwgrps / dfsubwgrps; + MSgroups := SSgroups / dfgroups; + MSa := SSa / dfa; + MSb := SSb / dfb; + MSab := SSab / dfab; + MSerrwithin := SSerrwithin / dferrwithin; + fgroups := MSgroups / MSsubwgrps; + fa := MSa / MSerrwithin; + fb := MSb / MSerrwithin; + fab := MSab / MSerrwithin; + probgrps := probf(fgroups,dfgroups,dfsubwgrps); + proba := probf(fa,dfa,dferrwithin); + probb := probf(fb,dfb,dferrwithin); + probab := probf(fab,dfab,dferrwithin); + + // show ANOVA table results + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Latin Squares Repeated Analysis Plan 6'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + OutputFrm.RichEdit.Lines.Add('Source SS DF MS F Prob.>F'); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + cellstring := 'Betw.Subj.'; + cellstring := cellstring + format('%9.3f %9.0f',[SSbetsubj,dfbetsubj]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor C '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSgroups,dfgroups,MSgroups,fgroups,probgrps]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Subj.w.g.'; + cellstring := cellstring + format('%9.3f %9.0f %9.3f',[SSsubwgrps,dfsubwgrps,MSsubwgrps]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Within Sub'; + cellstring := cellstring + format('%9.3f %9.0f',[SSwithinsubj,dfwithinsubj]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor A '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSa,dfa,MSa,fa,proba]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor B '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSb,dfb,MSb,fb,probb]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Residual '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSab,dfab,MSab,fab,probab]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Error w. '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f',[SSerrwithin,dferrwithin,MSerrwithin]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Total '; + cellstring := cellstring + format('%9.3f %9.0f',[SStotal, dftotal]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + + // show design for Square + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Experimental Design for Latin Square '; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' G C '; + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); // A (column) effect + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); // B (cell) effect + group := StrToInt(OS3MainFrm.DataGrid.Cells[Grpcol,i]); // group (row) + Design[group-1,row-1] := 'B' + IntToStr(col); + end; + for i := 0 to p - 1 do + begin + cellstring := format('%3d %3d ',[i+1,i+1]); + for j := 0 to p - 1 do + cellstring := cellstring + format('%5s',[Design[i,j]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + for i := 0 to p-1 do + for j := 0 to p-1 do + ABmat[i,j] := ABmat[i,j] / n; + for i := 0 to p-1 do + ABmat[i,p] := ABmat[i,p] / (n * p); + for j := 0 to p-1 do + ABmat[p,j] := ABmat[p,j] / (n * p); + + GrandMean := GrandMean / (p * p * n ); + for i := 0 to p-1 do + begin + Atotals[i] := Atotals[i] / (p * n); + Btotals[i] := Btotals[i] / (p * n); + Grptotals[i] := Grptotals[i] / (p * n); + end; + + // show table of means for ABmat + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Cell means and totals'); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[GroupFactor]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 0 to p-1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + cellstring := cellstring + format(' %8.3f ',[ABmat[i,j]]); + cellstring := cellstring + format(' %8.3f ',[ABmat[i,p]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := 'Total '; + for j := 0 to p-1 do + cellstring := cellstring + format(' %8.3f ',[ABmat[p,j]]); + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + // show category means + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Means for each variable'); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Atotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Btotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[GroupFactor]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Grptotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.ShowModal; + +cleanup: + GBmat := nil; + ColLabels := nil; + RowLabels := nil; + Subjtotals := nil; + Design := nil; + Grptotals := nil; + Btotals := nil; + Atotals := nil; + cellcnts := nil; + ABCmat := nil; + ABmat := nil; +end; + +procedure TLatinSqrsFrm.Plan7(Sender: TObject); +label cleanup; +var + NoFactors : integer; + n : integer; // no. of subjects per cell + Acol, Bcol, Ccol, SbjCol, Grpcol, DataCol : integer; // variable columns in grid + FactorA : string; + FactorB : string; + SubjectFactor : string; + FactorC : string; + GroupFactor : string; + DataVar : string; + cellstring : string; + i, j, k, minA, minB, minC, minGrp, maxA, maxB, maxC, maxGrp : integer; + rangeA, rangeB, rangeC, rangeGrp : integer; + value : integer; + cellcnts : IntDyneMat; + ABmat : DblDyneMat; + ABCmat : DblDyneCube; + GBmat : DblDyneMat; + GCmat : DblDyneMat; + Atotals : DblDyneVec; + Btotals : DblDyneVec; + Ctotals : DblDyneVec; + Grptotals : DblDyneVec; + Subjtotals : DblDyneMat; + design : StrDyneMat; + G, term1, term2, term3, term4, term5, term6, term7, term8, term9 : double; + sumxsqr : double; + SSbetsubj, SSgroups, SSsubwGrps, SSwithinsubj, SSa, SSb, SSc, SSab : double; + SSerrwithin, SStotal, MSgroups, MSsubwGrps, MSa, MSb, MSc, MSab : double; + MSerrwithin, DFbetsubj, DFgroups, DFsubwGrps, DFwithinsubj : double; + DFa, DFb, DFc, DFab, DFerrwithin, DFtotal : double; + data, GrandMean : double; + p, row, col, slice, subject, group : integer; + proba, probb, probc, probab, probgrps : double; + fa, fb, fc, fab, fgroups : double; + RowLabels, ColLabels : StrDyneVec; + Title : string; + +begin + NoFactors := 4; + LatinSpecsFrm.PanelD.Visible := true; + LatinSpecsFrm.PanelGrp.Visible := true; + LatinSpecsFrm.AinBtn.Enabled := true; + LatinSpecsFrm.AoutBtn.Enabled := false; + LatinSpecsFrm.BinBtn.Enabled := true; + LatinSpecsFrm.BoutBtn.Enabled := false; + LatinSpecsFrm.CinBtn.Enabled := true; + LatinSpecsFrm.CoutBtn.Enabled := false; +// LatinSpecsFrm.DCodeEdit.Visible := true; + LatinSpecsFrm.ACodeEdit.Text := ''; + LatinSpecsFrm.BCodeEdit.Text := ''; + LatinSpecsFrm.CCodeEdit.Text := ''; + LatinSpecsFrm.DCodeEdit.Text := ''; + LatinSpecsFrm.GrpCodeEdit.Text := ''; + LatinSpecsFrm.DepVarEdit.Text := ''; + LatinSpecsFrm.nPerCellEdit.Text := ''; +// LatinSpecsFrm.GrpCodeEdit.Visible := true; +// LatinSpecsFrm.DCodeLabel.Visible := true; +// LatinSpecsFrm.GrpCodeLabel.Visible := true; +// LatinSpecsFrm.DinBtn.Visible := true; +// LatinSpecsFrm.DoutBtn.Visible := true; + LatinSpecsFrm.DinBtn.Enabled := true; + LatinSpecsFrm.DoutBtn.Enabled := false; +// LatinSpecsFrm.GrpInBtn.Visible := true; +// LatinSpecsFrm.GrpOutBtn.Visible := true; + LatinSpecsFrm.GrpInBtn.Enabled := true; + LatinSpecsFrm.GrpOutBtn.Enabled := false; + LatinSpecsFrm.DataInBtn.Enabled := true; + LatinSpecsFrm.DataOutBtn.Enabled := false; + LatinSpecsFrm.ShowModal; + if LatinSpecsFrm.ModalResult = mrCancel then exit; + n := StrToInt(LatinSpecsFrm.nPerCellEdit.Text); + if n <= 0 then + begin + ShowMessage('Please specify the number of cases per cell.'); + exit; + end; + FactorA := LatinSpecsFrm.ACodeEdit.Text; + FactorB := LatinSpecsFrm.BCodeEdit.Text; + FactorC := LatinSpecsFrm.CCodeEdit.Text; + SubjectFactor := LatinSpecsFrm.DCodeEdit.Text; + GroupFactor := LatinSpecsFrm.GrpCodeEdit.Text; + DataVar := LatinSpecsFrm.DepVarEdit.Text; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = FactorA) then Acol := i; + if (cellstring = FactorB) then Bcol := i; + if (cellstring = FactorC) then Ccol := i; + if (cellstring = GroupFactor) then Grpcol := i; + if (cellstring = SubjectFactor) then Sbjcol := i; + if (cellstring = DataVar) then DataCol := i; + end; + + // determine no. of levels in A, B, C and Group + minA := 1000; + minB := 1000; + minGrp := 1000; + maxA := -1000; + maxB := -1000; + minC := 1000; + maxC := -1000; + maxGrp := -1000; + for i := 1 to NoCases do + begin + value := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + if value < minA then minA := value; + if value > maxA then maxA := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + if value < minB then minB := value; + if value > maxB then maxB := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + if value < minC then minC := value; + if value > maxC then maxC := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Grpcol,i]); + if value < minGrp then minGrp := value; + if value > maxGrp then maxGrp := value; + end; + rangeA := maxA - minA + 1; + rangeB := maxB - minB + 1; + rangeC := maxC - minC + 1; + rangeGrp := maxGrp - minGrp + 1; + + // check for squareness + if ((rangeA <> rangeB) or (rangeA <> rangeC) or (rangeA <> rangeGrp)) then + begin + ShowMessage('ERROR! In a Latin square the range of values should be equal for A,B and C!'); + exit; + end; + p := rangeA; + + // set up an array for cell counts and for cell sums and marginal sums + SetLength(ABmat,p+1,p+1); + SetLength(ABCmat,p+1,p+1,n+1); + SetLength(cellcnts,p+1,p+1); + SetLength(Atotals,p+1); + SetLength(Btotals,p+1); + SetLength(Ctotals,p+1); + SetLength(Grptotals,p+1); + SetLength(Design,p,p); + SetLength(Subjtotals,p+1,n+1); + SetLength(RowLabels,p+1); + SetLength(ColLabels,n+1); + SetLength(GBmat,p+1,p+1); + SetLength(GCmat,p+1,p+1); + + for i := 0 to p-1 do + begin + RowLabels[i] := IntToStr(i+1); + ColLabels[i] := RowLabels[i]; + end; + RowLabels[p] := 'Total'; + ColLabels[p] := 'Total'; + + for i := 0 to p do + for j := 0 to p do + for k := 0 to n do + ABCmat[i,j,k] := 0.0; + + for i := 0 to p do + begin + for j := 0 to p do + begin + cellcnts[i,j] := 0; + ABmat[i,j] := 0.0; + GBmat[i,j] := 0.0; + GCmat[i,j] := 0.0; + end; + end; + + for i := 0 to p do + begin + Atotals[i] := 0.0; + Btotals[i] := 0.0; + Ctotals[i] := 0.0; + Grptotals[i] := 0.0; + end; + + for i := 0 to p do + for j := 0 to n do + Subjtotals[i,j] := 0.0; + + G := 0.0; + sumxsqr := 0.0; + term1 := 0.0; + term2 := 0.0; + term3 := 0.0; + term4 := 0.0; + term5 := 0.0; + term6 := 0.0; + term7 := 0.0; + term8 := 0.0; + term9 := 0.0; + GrandMean := 0.0; + + // Read in the data + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + slice := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + group := StrToInt(OS3MainFrm.DataGrid.Cells[Grpcol,i]); + subject := StrToInt(OS3MainFrm.DataGrid.Cells[Sbjcol,i]); + data := StrToFloat(OS3MainFrm.DataGrid.Cells[DataCol,i]); + cellcnts[group-1,row-1] := cellcnts[group-1,row-1] + 1; + ABCmat[group-1,row-1,slice-1] := ABCmat[group-1,row-1,slice-1] + data; + Subjtotals[group-1,subject-1] := Subjtotals[group-1,subject-1] + data; + GBmat[group-1,col-1] := GBmat[group-1,col-1] + data; + GCmat[group-1,slice-1] := GCmat[group-1,slice-1] + data; + Atotals[row-1] := Atotals[row-1] + data; + Btotals[col-1] := Btotals[col-1] + data; + Ctotals[slice-1] := Ctotals[slice-1] + data; + Grptotals[group-1] := Grptotals[group-1] + data; + sumxsqr := sumxsqr + (data * data); + GrandMean := GrandMean + data; + end; + + // check for equal cell counts + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + if cellcnts[i,j] <> n then + begin + ShowMessage('cell sizes are not equal!'); + goto cleanup; + end; + end; + end; + + // collapse slices into group x a matrix + // result is the group times A matrix with BC cells containing n cases each + for i := 0 to p-1 do // group + for j := 0 to p-1 do // factor a + for k := 0 to n-1 do // factor c + ABmat[i,j] := ABmat[i,j] + ABCmat[i,j,k]; + + // get marginal totals for ABmat, GBmat and GCmat + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + ABmat[p,j] := ABmat[p,j] + ABmat[i,j]; + ABmat[i,p] := ABmat[i,p] + ABmat[i,j]; + GBmat[p,j] := GBmat[p,j] + GBmat[i,j]; + GBmat[i,p] := GBmat[i,p] + GBmat[i,j]; + GCmat[p,j] := GCmat[p,j] + GCmat[i,j]; + GCmat[i,p] := GCmat[i,p] + GCmat[i,j]; + end; + end; + + // get grand total for ABmat, GBmat and GCmat + for i := 0 to p-1 do + begin + ABmat[p,p] := ABmat[p,p] + ABmat[p,i]; + GBmat[p,p] := GBmat[p,p] + GBmat[p,i]; + GCmat[p,p] := GCmat[p,p] + GCmat[p,i]; + end; + + // Get marginal totals for Subjtotals + for i := 0 to p-1 do // groups 1-p + begin + for j := 0 to n-1 do // subjects 1-n + begin + Subjtotals[p,j] := Subjtotals[p,j] + Subjtotals[i,j]; + Subjtotals[i,n] := Subjtotals[i,n] + Subjtotals[i,j]; + end; + end; + for i := 0 to p-1 do Subjtotals[p,n] := Subjtotals[p,n] + Subjtotals[i,n]; + + // test block + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Latin Squares Repeated Analysis Plan 7 (superimposed squares)'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Sums for ANOVA Analysis'); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Group (rows) times A Factor (columns) sums'; + MAT_PRINT(ABmat,p+1,p+1,cellstring,RowLabels,ColLabels,(n*p*p)); + cellstring := 'Group (rows) times B (cells Factor) sums'; + MAT_PRINT(GBmat,p+1,p+1,cellstring,RowLabels,ColLabels,(n*p*p)); + cellstring := 'Group (rows) times C (cells Factor) sums'; + MAT_PRINT(GCmat,p+1,p+1,cellstring,RowLabels,ColLabels,(n*p*p)); + for i := 0 to n-1 do ColLabels[i] := IntToStr(i+1); + ColLabels[n] := 'Total'; + Title := 'Group (rows) times Subjects (columns) sums'; + Mat_Print(Subjtotals,p+1,n+1,Title,RowLabels,ColLabels,(n*p*p)); + OutputFrm.ShowModal; + + // get squared sum of subject's totals in each group + for i := 0 to p-1 do // group + term7 := term7 + (Subjtotals[i,n] * Subjtotals[i,n]); + term7 := term7 / (n*p); // Sum G^2 sub k + + // now square each person score in each group and get sum for group + for i := 0 to p-1 do // groups + for j := 0 to n-1 do // subjects + Subjtotals[i,j] := Subjtotals[i,j] * Subjtotals[i,j]; + for i := 0 to p-1 do Subjtotals[i,n] := 0.0; // clear group totals + + // get sum of squared person scores in each group + for i := 0 to p-1 do // groups + for j := 0 to n-1 do // subjects + Subjtotals[i,n] := Subjtotals[i,n] + Subjtotals[i,j]; + + // get sum of squares for subjects within groups + for i := 0 to p-1 do term6 := term6 + Subjtotals[i,n]; + SSsubwgrps := (term6 / p) - term7; + + // get correction term and term for total sum of squares + term1 := (GrandMean * GrandMean) / (n * p * p); + term2 := sumxsqr; + + // get sum of squared groups for term4 of sum of squares for groups + for i := 0 to p-1 do + term4 := term4 + (Grptotals[i] * Grptotals[i]); + term4 := term4 / (n * p); + + // get sum of squared a's for term3 + for j := 0 to p-1 do // levels of a + term3 := term3 + (Atotals[j] * Atotals[j]); + term3 := term3 / (n * p); + + // get squared sum of b's (across groups) for term5 of sum of squares b + for j := 0 to p-1 do + term5 := term5 + (Btotals[j] * Btotals[j]); + term5 := term5 / (n * p); + + // get squared sum of c's (across groups) for term8 of SS for c + for j := 0 to p-1 do + term8 := term8 + (Ctotals[j] * Ctotals[j]); + term8 := term8 / (n * p); + + SSgroups := term4 - term1; + SSbetsubj := SSgroups + SSsubwgrps; + SStotal := term2 - term1; + SSwithinsubj := SStotal - SSbetsubj; + SSa := term3 - term1; + SSb := term5 - term1; + SSc := term8 - term1; + + // get sum of squared AB cells for term6 + term6 := 0.0; + for i := 0 to p-1 do + for j := 0 to p-1 do + term6 := term6 + (ABmat[i,j] * ABmat[i,j]); + term9 := term6 / n - term1; + term6 := sumxsqr - (term6 / n); // SS within cells from sum squared x's + SSerrwithin := term6 - SSsubwgrps; + SSab := term9 - (SSa + SSb + SSc + SSgroups); // residual + + // record degrees of freedom for sources + dfbetsubj := n * p - 1; + dfsubwgrps := p * (n-1); + dfgroups := p - 1; + dftotal := n * p * p - 1; + dfwithinsubj := n * p * (p-1); + dfa := p - 1; + dfb := p - 1; + dfc := p - 1; + dfab := (p - 1) * (p - 3); + dferrwithin := p * (n - 1) * (p - 1); + + MSsubwgrps := SSsubwgrps / dfsubwgrps; + MSgroups := SSgroups / dfgroups; + MSa := SSa / dfa; + MSb := SSb / dfb; + MSc := SSc / dfc; + if dfab > 0 then MSab := SSab / dfab; + MSerrwithin := SSerrwithin / dferrwithin; + fgroups := MSgroups / MSsubwgrps; + fa := MSa / MSerrwithin; + fb := MSb / MSerrwithin; + fc := MSc / MSerrwithin; + if dfab > 0 then fab := MSab / MSerrwithin; + probgrps := probf(fgroups,dfgroups,dfsubwgrps); + proba := probf(fa,dfa,dferrwithin); + probb := probf(fb,dfb,dferrwithin); + probc := probf(fc,dfc,dferrwithin); + probab := probf(fab,dfab,dferrwithin); + + // show ANOVA table results + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Latin Squares Repeated Analysis Plan 7 (superimposed squares)'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + OutputFrm.RichEdit.Lines.Add('Source SS DF MS F Prob.>F'); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + cellstring := 'Betw.Subj.'; + cellstring := cellstring + format('%9.3f %9.0f',[SSbetsubj,dfbetsubj]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Groups '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSgroups,dfgroups,MSgroups,fgroups,probgrps]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Subj.w.g.'; + cellstring := cellstring + format('%9.3f %9.0f %9.3f',[SSsubwgrps,dfsubwgrps,MSsubwgrps]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Within Sub'; + cellstring := cellstring + format('%9.3f %9.0f',[SSwithinsubj,dfwithinsubj]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor A '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSa,dfa,MSa,fa,proba]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor B '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSb,dfb,MSb,fb,probb]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor C '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSc,dfc,MSc,fc,probc]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' residual '; + if dfab > 0 then + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSab,dfab,MSab,fab,probab]) + else + cellstring := cellstring + format(' - %9.0f -',[dfab]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Error w. '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f',[SSerrwithin,dferrwithin,MSerrwithin]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Total '; + cellstring := cellstring + format('%9.3f %9.0f',[SStotal, dftotal]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + + // show design for Square + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Experimental Design for Latin Square '; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[GroupFactor]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); // A (column) effect + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); // B (cell) effect + slice := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); // C (cell) effect + group := StrToInt(OS3MainFrm.DataGrid.Cells[Grpcol,i]); // group (row) + Design[group-1,row-1] := 'BC' + IntToStr(col) + IntToStr(slice); + end; + for i := 0 to p - 1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + cellstring := cellstring + format('%5s',[Design[i,j]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + // get means + for i := 0 to p-1 do + for j := 0 to p-1 do + ABmat[i,j] := ABmat[i,j] / n; + for i := 0 to p-1 do + ABmat[i,p] := ABmat[i,p] / (n * p); + for j := 0 to p-1 do + ABmat[p,j] := ABmat[p,j] / (n * p); + + GrandMean := GrandMean / (p * p * n ); + for i := 0 to p-1 do + begin + Atotals[i] := Atotals[i] / (p * n); + Btotals[i] := Btotals[i] / (p * n); + Ctotals[i] := Ctotals[i] / (p * n); + Grptotals[i] := Grptotals[i] / (p * n); + end; + + // show table of means for ABmat + // means for Groups by A matrix + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Cell means and totals'); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[GroupFactor]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 0 to p-1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + cellstring := cellstring + format(' %8.3f ',[ABmat[i,j]]); + cellstring := cellstring + format(' %8.3f ',[ABmat[i,p]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := 'Total '; + for j := 0 to p-1 do + cellstring := cellstring + format(' %8.3f ',[ABmat[p,j]]); + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + // show category means + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Means for each variable'); + OutputFrm.RichEdit.Lines.Add(''); + + // factor A means + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Atotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + // means for B + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorB]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Btotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + // C means + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorC]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Ctotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + + // Group means + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[GroupFactor]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + cellstring := cellstring + ' Total'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p - 1 do + begin + cellstring := cellstring + format(' %8.3f ',[Grptotals[j]]); + end; + cellstring := cellstring + format(' %8.3f ',[GrandMean]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '----------'; + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.ShowModal; + +cleanup: + GCmat := nil; + GBmat := nil; + ColLabels := nil; + RowLabels := nil; + Subjtotals := nil; + Design := nil; + Grptotals := nil; + Ctotals := nil; + Btotals := nil; + Atotals := nil; + cellcnts := nil; + ABCmat := nil; + ABmat := nil; +end; + +procedure TLatinSqrsFrm.Plan9(Sender: TObject); +label cleanup; +var + NoFactors, row, col, slice, group, index : integer; + Acol, Bcol, Ccol, SbjCol, Grpcol, DataCol : integer; // variable columns in grid + FactorA : string; + FactorB : string; + FactorC : string; + SubjectFactor : string; + GroupFactor : string; + DataVar : string; + cellstring : string; + i, j, k, m, minA, minB, minC, minGrp, maxA, maxB, maxC, maxGrp : integer; + n, subject, nosubjects, rangeA, rangeB, rangeC, rangeGrp : integer; + p, q, rows, value : integer; + ABC, AGC : DblDyneCube; + AB, AC, BC, RC : DblDyneMat; + A, B, C, Persons, Gm, R : DblDyneVec; + cellcnts : IntDyneVec; + Design : StrDyneMat; + RowLabels : StrDyneVec; + ColLabels : StrDyneVec; + G, sumxsqr, sumAsqr, sumBsqr, sumABsqr, sumACsqr : double; + sumBCsqr, sumABCsqr, sumPsqr, sumGmsqr, sumRsqr : double; + SSbetsubj, SSc, SSrows, SScxrow, SSsubwgrps, SSa : double; + SSwithinsubj, SSerrwithin : double; + SSb, SSac, SSbc, SSabprime, SSABCprime, SStotal : double; + term1, term2, term3, term4, term5, term6, term7, term8, term9, term10 : double; + term11, term12 : double; + dfc, dfrows, dfcxrow, dfsubwgrps, dfwithinsubj, dfa, dfb,dfac : double; + dfbc, dfabprime, dfabcprime,dferrwithin, dftotal, dfbetsubj : double; + MSc, MSrows, MScxrow, MSsubwgrps, MSa : double; + MSb, MSac, MSbc, MSabprime, MSabcprime, MSerrwithin: double; + fc, frows, fcxrow, fsubwgrps, fa, fb, fac, fbc, fabprime, fabcprime : double; + probc, probrows, probcxrow, probsubwgrps, proba, probb : double; + probac, probbc, probabprime, probabcprime : double; + data : double; + +begin + NoFactors := 4; + cellstring := LatinSpecsFrm.DCodeLabel.Caption; // get current label + LatinSpecsFrm.DCodeLabel.Caption := 'Subject No.'; // set new label + LatinSpecsFrm.PanelD.Visible := true; + LatinSpecsFrm.PanelGrp.Visible := true; + LatinSpecsFrm.AinBtn.Enabled := true; + LatinSpecsFrm.AoutBtn.Enabled := false; + LatinSpecsFrm.BinBtn.Enabled := true; + LatinSpecsFrm.BoutBtn.Enabled := false; + LatinSpecsFrm.CinBtn.Enabled := true; + LatinSpecsFrm.CoutBtn.Enabled := false; +// LatinSpecsFrm.DCodeEdit.Visible := true; + LatinSpecsFrm.ACodeEdit.Text := ''; + LatinSpecsFrm.BCodeEdit.Text := ''; + LatinSpecsFrm.CCodeEdit.Text := ''; + LatinSpecsFrm.DCodeEdit.Text := ''; + LatinSpecsFrm.GrpCodeEdit.Text := ''; + LatinSpecsFrm.DepVarEdit.Text := ''; + LatinSpecsFrm.nPerCellEdit.Text := ''; +// LatinSpecsFrm.GrpCodeEdit.Visible := true; +// LatinSpecsFrm.DCodeLabel.Visible := true; +// LatinSpecsFrm.GrpCodeLabel.Visible := true; +// LatinSpecsFrm.DinBtn.Visible := true; +// LatinSpecsFrm.DoutBtn.Visible := true; + LatinSpecsFrm.DinBtn.Enabled := true; + LatinSpecsFrm.DoutBtn.Enabled := false; +// LatinSpecsFrm.GrpInBtn.Visible := true; +// LatinSpecsFrm.GrpOutBtn.Visible := true; + LatinSpecsFrm.GrpInBtn.Enabled := true; + LatinSpecsFrm.GrpOutBtn.Enabled := false; + LatinSpecsFrm.DataInBtn.Enabled := true; + LatinSpecsFrm.DataOutBtn.Enabled := false; + LatinSpecsFrm.ShowModal; + if LatinSpecsFrm.ModalResult = mrCancel then exit; + LatinSpecsFrm.DCodeLabel.Caption := cellstring; // restore label + n := StrToInt(LatinSpecsFrm.nPerCellEdit.Text); // no. persons per cell + if n <= 0 then + begin + ShowMessage('Please specify the number of subjects per group.'); + exit; + end; + FactorA := LatinSpecsFrm.ACodeEdit.Text; + FactorB := LatinSpecsFrm.BCodeEdit.Text; + FactorC := LatinSpecsFrm.CCodeEdit.Text; + SubjectFactor := LatinSpecsFrm.DCodeEdit.Text; + GroupFactor := LatinSpecsFrm.GrpCodeEdit.Text; + DataVar := LatinSpecsFrm.DepVarEdit.Text; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = FactorA) then Acol := i; + if (cellstring = FactorB) then Bcol := i; + if (cellstring = FactorC) then Ccol := i; + if (cellstring = GroupFactor) then Grpcol := i; + if (cellstring = SubjectFactor) then Sbjcol := i; + if (cellstring = DataVar) then DataCol := i; + end; + + // determine no. of levels in A, B, C and Group + minA := 1000; + minB := 1000; + minGrp := 1000; + maxA := -1000; + maxB := -1000; + minC := 1000; + maxC := -1000; + maxGrp := -1000; + nosubjects := 0; + for i := 1 to NoCases do + begin + value := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); + if value < minA then minA := value; + if value > maxA then maxA := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); + if value < minB then minB := value; + if value > maxB then maxB := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); + if value < minC then minC := value; + if value > maxC then maxC := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[sbjcol,i]); + if value > nosubjects then nosubjects := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[Grpcol,i]); + if value < minGrp then minGrp := value; + if value > maxGrp then maxGrp := value; + end; + rangeA := maxA - minA + 1; + rangeB := maxB - minB + 1; + rangeC := maxC - minC + 1; + rangeGrp := maxGrp - minGrp + 1; + + // check for squareness + if (rangeA <> rangeB) then + begin + ShowMessage('ERROR! In a Latin square the range of values should be equal for A,B and C!'); + exit; + end; + p := rangeA; + q := rangeC; + + // set up an array for cell counts and for cell sums and marginal sums + SetLength(ABC,p+1,p+1,q+1); + SetLength(AGC,p+1,rangegrp+1,q+1); + SetLength(AB,p+1,p+1); + SetLength(AC,p+1,q+1); + SetLength(BC,p+1,q+1); + SetLength(RC,(rangegrp div q)+1,q+1); + SetLength(A,p+1); + SetLength(B,p+1); + SetLength(C,q+1); + SetLength(Persons,nosubjects+1); + SetLength(Gm,rangegrp+1); + SetLength(R,p+1); + SetLength(cellcnts,p+1); + SetLength(Design,rangegrp,p); + SetLength(RowLabels,100); + SetLength(ColLabels,100); + + // initialize arrays + for i := 0 to p-1 do + begin + RowLabels[i] := IntToStr(i+1); + ColLabels[i] := RowLabels[i]; + end; + RowLabels[p] := 'Total'; + ColLabels[p] := 'Total'; + + for i := 0 to p do + for j := 0 to p do + for k := 0 to q do + ABC[i,j,k] := 0.0; + + for i := 0 to p do + for j := 0 to rangegrp do + for k := 0 to q do + AGC[i,j,k] := 0.0; + + for i := 0 to p do + for j := 0 to p do + AB[i,j] := 0.0; + + for i := 0 to p do + for j := 0 to q do + AC[i,j] := 0.0; + + for i := 0 to p do + for j := 0 to q do + BC[i,j] := 0.0; + + for i := 0 to p do + for j := 0 to q do + RC[i,j] := 0.0; + + for i := 0 to p do A[i] := 0.0; + for i := 0 to p do B[i] := 0.0; + for i := 0 to q do C[i] := 0.0; + for i := 0 to nosubjects do Persons[i] := 0.0; + for i := 0 to rangegrp do Gm[i] := 0.0; + for i := 0 to p do R[i] := 0.0; + for i := 0 to p do cellcnts[i] := 0; + + // initialize single values + G := 0.0; + sumxsqr := 0.0; + sumAsqr := 0.0; + sumBsqr := 0.0; + sumABsqr := 0.0; + sumACsqr := 0.0; + sumBCsqr := 0.0; + sumABCsqr := 0.0; + sumRsqr := 0.0; + sumGmsqr := 0.0; + sumRsqr := 0.0; + sumPsqr := 0.0; + term2 := 0.0; + term3 := 0.0; + term4 := 0.0; + term5 := 0.0; + term6 := 0.0; + term7 := 0.0; + term8 := 0.0; + term9 := 0.0; + term10 := 0.0; + term11 := 0.0; + term12 := 0.0; + + // Read in the data + for index := 1 to NoCases do + begin + i := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,index]); + j := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,index]); + k := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,index]); + m := StrToInt(OS3MainFrm.DataGrid.Cells[Grpcol,index]); + subject := StrToInt(OS3MainFrm.DataGrid.Cells[Sbjcol,index]); + data := StrToFloat(OS3MainFrm.DataGrid.Cells[DataCol,index]); + cellcnts[j-1] := cellcnts[j-1] + 1; + ABC[i-1,j-1,k-1] := ABC[i-1,j-1,k-1] + data; + AGC[i-1,m-1,k-1] := AGC[i-1,m-1,k-1] + data; + AB[i-1,j-1] := AB[i-1,j-1] + data; + AC[i-1,k-1] := AC[i-1,k-1] + data; + BC[j-1,k-1] := BC[j-1,k-1] + data; + A[i-1] := A[i-1] + data; + B[j-1] := B[j-1] + data; + C[k-1] := C[k-1] + data; + Gm[m-1] := Gm[m-1] + data; + Persons[subject-1] := Persons[subject-1] + data; + sumxsqr := sumxsqr + (data * data); + G := G + data; + end; + + // check for equal cell counts in b treatments + for i := 1 to p-1 do + begin + if cellcnts[i-1] <> cellcnts[i] then + begin + ShowMessage('cell sizes are not equal!'); + goto cleanup; + end; + end; + + // get sums in the RC matrix + rows := rangegrp div q; + for i := 0 to rows - 1 do + begin + for j := 0 to q-1 do + begin +// k := (i * q) + j; + k := i + q * j; + RC[i,j] := Gm[k]; + end; + end; + + // get marginal totals for RC array + for i := 0 to rows -1 do + begin + for j := 0 to q-1 do + begin + RC[i,q] := RC[i,q] + RC[i,j]; + RC[rows,j] := RC[rows,j] + RC[i,j]; + end; + end; + + // get marginal totals for arrays ABC and AGC + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + for k := 0 to q-1 do + begin + ABC[i,j,q] := ABC[i,j,q] + ABC[i,j,k]; + ABC[i,p,k] := ABC[i,p,k] + ABC[i,j,k]; + ABC[p,j,k] := ABC[p,j,k] + ABC[i,j,k]; + end; + end; + end; + + for i := 0 to p-1 do + begin + for j := 0 to rangegrp - 1 do + begin + for k := 0 to q-1 do + begin + AGC[i,j,q] := AGC[i,j,q] + AGC[i,j,k]; + AGC[i,rangegrp,k] := AGC[i,rangegrp,k] + AGC[i,j,k]; + AGC[p,j,k] := AGC[p,j,k] + AGC[i,j,k]; + end; + end; + end; + + for i := 0 to p-1 do + begin + for j := 0 to q-1 do + begin + AC[p,j] := AC[p,j] + AC[i,j]; + AC[i,q] := AC[i,q] + AC[i,j]; + BC[p,j] := BC[p,j] + BC[i,j]; + BC[i,q] := BC[i,q] + BC[i,j]; + end; + end; + + // get grand total for AC, BC and RC + for i := 0 to q-1 do + begin + AC[p,q] := AC[p,q] + AC[p,i]; + BC[p,q] := BC[p,q] + BC[p,i]; + RC[p,q] := RC[p,q] + RC[p,i]; + end; + + // get margins and totals in AB matrix + for i := 0 to p-1 do + begin + for j := 0 to p-1 do + begin + AB[p,j] := AB[p,j] + AB[i,j]; + AB[i,p] := AB[i,p] + AB[i,j]; + end; + end; + for i := 0 to p-1 do AB[p,p] := AB[p,p] + AB[i,p]; + + // get total for groups + for m := 0 to rangegrp - 1 do Gm[rangegrp] := Gm[rangegrp] + Gm[m]; + + // test block + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Latin Squares Repeated Analysis Plan 9'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Sums for ANOVA Analysis'); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'ABC matrix'; + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + for k := 0 to q-1 do + begin + cellstring := format('C level %d',[k+1]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p-1 do cellstring := cellstring + format(' %3d ',[j+1]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 0 to p-1 do // row + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p-1 do + begin + cellstring := cellstring + format('%9.3f ',[ABC[i,j,k]]); + end; + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add(''); + end; + cellstring := 'AB sums'; + MAT_PRINT(AB,p+1,p+1,cellstring,RowLabels,ColLabels,(n*p*q)); + cellstring := 'AC sums'; + MAT_PRINT(AC,p+1,q+1,cellstring,RowLabels,ColLabels,(n*p*q)); + cellstring := 'BC sums'; + MAT_PRINT(BC,p+1,q+1,cellstring,RowLabels,ColLabels,(n*p*q)); + cellstring := 'RC sums'; + MAT_PRINT(RC,rows+1,q+1,cellstring,RowLabels,ColLabels,(n*p*q)); + cellstring := 'Group totals'; + for i := 0 to rangegrp-1 do ColLabels[i] := IntToStr(i+1); + ColLabels[rangegrp] := 'Total'; + DynVectorPrint(Gm,rangegrp+1,cellstring,ColLabels,(n*p*q)); + for i := 0 to nosubjects-1 do ColLabels[i] := IntToStr(i+1); + ColLabels[nosubjects] := 'Total'; + cellstring := 'Subjects sums'; + DynVectorPrint(Persons,nosubjects+1,cellstring,ColLabels,(n*p*q)); + OutputFrm.ShowModal; + + term1 := (G * G) / (n * p * p * q); + term2 := sumXsqr; + for i := 0 to p-1 do term3 := term3 + (A[i] * A[i]); + term3 := term3 / (n * p * q); + for i := 0 to p-1 do term4 := term4 + (B[i] * B[i]); + term4 := term4 / (n * p * q); + for i := 0 to q-1 do term5 := term5 + (C[i] * C[i]); + term5 := term5 / (n * p * p); + for i := 0 to p-1 do + for j := 0 to p-1 do + term6 := term6 + (AB[i,j] * AB[i,j]); + term6 := term6 / (n * q); + for i := 0 to p-1 do + for j := 0 to q-1 do + term7 := term7 + (AC[i,j] * AC[i,j]); + term7 := term7 / (n * p); + for i := 0 to p-1 do + for j := 0 to q-1 do + term8 := term8 + (BC[i,j] * BC[i,j]); + term8 := term8 / (n * p); + for i := 0 to p-1 do + for j := 0 to p-1 do + for k := 0 to q-1 do + term9 := term9 + (ABC[i,j,k] * ABC[i,j,k]); + term9 := term9 / n; + for i := 0 to nosubjects-1 do term10 := term10 + (persons[i] * persons[i]); + term10 := term10 / p; + for i := 0 to rangegrp-1 do term11 := term11 + (Gm[i] * Gm[i]); + term11 := term11 / (n * p); + for i := 0 to rows-1 do term12 := term12 + (RC[i,q] * RC[i,q]); + term12 := term12 / (n * p * q); + + // term check + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Computation Terms'); + cellstring := format('Term1 = %9.3f',[term1]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('term2 = %9.3f',[term2]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('term3 = %9.3f',[term3]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('term4 = %9.3f',[term4]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('term5 = %9.3f',[term5]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('term6 = %9.3f',[term6]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('term7 = %9.3f',[term7]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('term8 = %9.3f',[term8]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('term9 = %9.3f',[term9]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('term10 = %9.3f',[term10]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('term11 = %9.3f',[term11]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('term12 = %9.3f',[term12]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // now get sums of squares + SSbetsubj := term10 - term1; + SSc := term5 - term1; + SSrows := term12 - term1; + SScxrow := term11 - term5 - term12 + term1; + SSsubwgrps := term10 - term11; + SSwithinsubj := term2 - term10; + SSa := term3 - term1; + SSb := term4 - term1; + SSac := term7 - term3 - term5 + term1; + SSbc := term8 - term4 - term5 + term1; + SSabprime := (term6 - term3 - term4 + term1) - (term12 - term1); + SSabcprime := (term9 - term6 - term7 - term8 + term3 + term4 + term5 - term1) + - (term11 - term5 - term12 + term1); + SSerrwithin := term2 - term10 - term9 + term11; + SStotal := term2 - term1; + + // record degrees of freedom for sources + dfbetsubj := n * p * q - 1; + dfc := q - 1; + dfrows := p - 1; + dfcxrow := (p-1) * (q-1); + dfsubwgrps := p * q * (n-1); + dfwithinsubj := n * p * q * (p-1); + dfa := p - 1; + dfb := p - 1; + dfac := (p - 1) * (q - 1); + dfbc := (p - 1) * (q - 1); + dfabprime := (p - 1) * (p - 2); + dfabcprime := (p - 1) * (p - 2) * (q - 1); + dferrwithin := p * q * (n - 1) * (p - 1); + dftotal := n * p * p * q - 1; + + MSc := SSc / dfc; + MSrows := SSrows / dfrows; + MScxrow := SScxrow / dfcxrow; + MSsubwgrps := SSsubwgrps / dfsubwgrps; + MSa := SSa / dfa; + MSb := SSb / dfb; + MSac := SSac / dfac; + MSbc := SSbc / dfbc; + MSabprime := SSabprime / dfabprime; + MSabcprime := SSabcprime / dfabcprime; + MSerrwithin := SSerrwithin / dferrwithin; + + fc := MSc / MSsubwgrps; + frows := MSrows / MSsubwgrps; + fcxrow := MScxrow / MSsubwgrps; + fsubwgrps := MSsubwgrps / MSerrwithin; + fa := MSa / MSerrwithin; + fb := MSb / MSerrwithin; + fac := MSac / MSerrwithin; + fbc := MSbc / MSerrwithin; + fabprime := MSabprime / MSerrwithin; + fabcprime := MSabcprime / MSerrwithin; + + probc := probf(fc,dfc,dfsubwgrps); + probrows := probf(frows,dfrows,dfsubwgrps); + probcxrow := probf(fcxrow,dfcxrow,dfsubwgrps); + probsubwgrps := probf(fsubwgrps,dfsubwgrps,dferrwithin); + proba := probf(fa,dfa,dferrwithin); + probb := probf(fb,dfb,dferrwithin); + probac := probf(fac,dfac,dferrwithin); + probbc := probf(fbc,dfbc,dferrwithin); + probabprime := probf(fabprime,dfabprime,dferrwithin); + probabcprime := probf(fabcprime,dfabcprime,dferrwithin); + + // show ANOVA table results + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Latin Squares Repeated Analysis Plan 9'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + OutputFrm.RichEdit.Lines.Add('Source SS DF MS F Prob.>F'); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + cellstring := 'Betw.Subj.'; + cellstring := cellstring + format('%9.3f %9.0f',[SSbetsubj,dfbetsubj]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor C '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSc,dfc,MSc,fc,probc]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Rows '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSrows,dfrows,MSrows,frows,probrows]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' C x row '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SScxrow,dfcxrow,MScxrow,fcxrow,probcxrow]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Subj.w.g.'; + cellstring := cellstring + format('%9.3f %9.0f %9.3f',[SSsubwgrps,dfsubwgrps,MSsubwgrps]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Within Sub'; + cellstring := cellstring + format('%9.3f %9.0f',[SSwithinsubj,dfwithinsubj]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor A '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSa,dfa,MSa,fa,proba]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor B '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSb,dfb,MSb,fb,probb]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor AC'; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSac,dfac,MSac,fac,probac]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Factor BC'; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSbc,dfbc,MSbc,fbc,probbc]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' AB prime '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSabprime,dfabprime,MSabprime,fabprime,probabprime]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' ABC prime'; + cellstring := cellstring + format('%9.3f %9.0f %9.3f %9.3f %9.3f',[SSabcprime,dfabcprime,MSabcprime,fabcprime,probabcprime]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' Error w. '; + cellstring := cellstring + format('%9.3f %9.0f %9.3f',[SSerrwithin,dferrwithin,MSerrwithin]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := 'Total '; + OutputFrm.RichEdit.Lines.Add(''); + cellstring := cellstring + format('%9.3f %9.0f',[SStotal, dftotal]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add('-----------------------------------------------------------'); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // show design for Squares c1, c2, etc. + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'Experimental Design for Latin Square '; + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[FactorA]); + for i := 1 to p do cellstring := cellstring + format(' %3d ',[i]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('%10s',[GroupFactor]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 1 to NoCases do + begin + row := StrToInt(OS3MainFrm.DataGrid.Cells[Acol,i]); // A (column) effect + col := StrToInt(OS3MainFrm.DataGrid.Cells[Bcol,i]); // B (cell) effect + slice := StrToInt(OS3MainFrm.DataGrid.Cells[Ccol,i]); // C (cell) effect + group := StrToInt(OS3MainFrm.DataGrid.Cells[Grpcol,i]); // group (row) + Design[group-1,row-1] := 'B' + IntToStr(col); + end; + for i := 0 to rangegrp - 1 do + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p - 1 do + cellstring := cellstring + format('%5s',[Design[i,j]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + cellstring := '----------'; + for i := 1 to p + 1 do cellstring := cellstring + '-----'; + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // get means + G := G / (p * p * q * n ); + for i := 0 to p-1 do + for j := 0 to p-1 do + for k := 0 to q-1 do + ABC[i,j,k] := ABC[i,j,k] / n; + + for i := 0 to p-1 do + for j := 0 to p-1 do + AB[i,j] := AB[i,j] / (n * p); + for i := 0 to p-1 do AB[i,p] := AB[i,p] / (n * p * p); + for j := 0 to p-1 do AB[p,j] := AB[p,j] / (n * p * p); + AB[p,p] := G; + + for i := 0 to p-1 do + for j := 0 to q-1 do + AC[i,j] := AC[i,j] / (n * p); + for i := 0 to p-1 do AC[i,q] := AC[i,q] / (n * p * p); + for j := 0 to q-1 do AC[p,j] := AC[p,j] / (n * p * p); + AC[p,q] := G; + + for i := 0 to p-1 do + for j := 0 to q-1 do + BC[i,j] := BC[i,j] / (n * p); + for i := 0 to p-1 do BC[i,q] := BC[i,q] / (n * p * p); + for j := 0 to q-1 do BC[p,j] := BC[p,j] / (n * p * p); + BC[p,q] := G; + + for i := 0 to rows-1 do + for j := 0 to q-1 do + RC[i,j] := RC[i,j] / (p * n); + for i := 0 to rows-1 do RC[i,q] := RC[i,q] / (p * q * n); + for j := 0 to q-1 do RC[p,j] := RC[p,j] / (q * p * n); + RC[p,q] := G; + + for i := 0 to p-1 do + begin + A[i] := A[i] / (p * n * q); + B[i] := B[i] / (p * n * q); + end; + A[p] := G; + B[p] := G; + + for i := 0 to q-1 do C[i] := C[i] / (p * q * n); + C[q] := G; + + for i := 0 to rangegrp-1 do Gm[i] := Gm[i] / (p * n); + Gm[rangegrp] := G; + + for i := 0 to nosubjects-1 do Persons[i] := Persons[i] / n; + Persons[nosubjects] := G; + + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Latin Squares Repeated Analysis Plan 9'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Means for ANOVA Analysis'); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := 'ABC matrix'; + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + for k := 0 to q-1 do + begin + cellstring := format('C level %d',[k+1]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := ' '; + for j := 0 to p-1 do cellstring := cellstring + format(' %3d ',[j+1]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 0 to p-1 do // row + begin + cellstring := format(' %3d ',[i+1]); + for j := 0 to p-1 do + begin + cellstring := cellstring + format('%9.3f ',[ABC[i,j,k]]); + end; + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add(''); + end; + cellstring := 'AB Means'; + MAT_PRINT(AB,p+1,p+1,cellstring,RowLabels,ColLabels,(n*p*p*q)); + cellstring := 'AC Means'; + MAT_PRINT(AC,p+1,q+1,cellstring,RowLabels,ColLabels,(n*p*p*q)); + cellstring := 'BC Means'; + MAT_PRINT(BC,p+1,q+1,cellstring,RowLabels,ColLabels,(n*p*p*q)); + cellstring := 'RC Means'; + MAT_PRINT(RC,rows+1,q+1,cellstring,RowLabels,ColLabels,(n*p*p*q)); + cellstring := 'Group Means'; + for i := 0 to rangegrp-1 do ColLabels[i] := IntToStr(i+1); + ColLabels[rangegrp] := 'Total'; + DynVectorPrint(Gm,rangegrp+1,cellstring,ColLabels,(n*p*p*q)); + for i := 0 to nosubjects-1 do ColLabels[i] := IntToStr(i+1); + ColLabels[nosubjects] := 'Total'; + cellstring := 'Subjects Means'; + DynVectorPrint(Persons,nosubjects+1,cellstring,ColLabels,(n*p*p*q)); + OutputFrm.ShowModal; + +cleanup: + ColLabels := nil; + RowLabels := nil; + Design := nil; + cellcnts := nil; + R := nil; + Gm := nil; + Persons := nil; + C := nil; + B := nil; + A := nil; + RC := nil; + BC := nil; + AC := nil; + AB := nil; + AGC := nil; + ABC := nil; +end; + +initialization + {$I latinsqrsunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/onecaseanovaunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/onecaseanovaunit.lfm new file mode 100644 index 000000000..d384e3120 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/onecaseanovaunit.lfm @@ -0,0 +1,583 @@ +object OneCaseAnovaForm: TOneCaseAnovaForm + Left = 694 + Height = 458 + Top = 246 + Width = 567 + AutoSize = True + Caption = 'OneCaseAnovaForm' + ClientHeight = 458 + ClientWidth = 567 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideLeft.Control = PlotOptionsBox + AnchorSideTop.Control = PlotOptionsBox + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = PlotOptionsBox + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = OverAllAlpha + Left = 364 + Height = 135 + Top = 146 + Width = 195 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 16 + BorderSpacing.Bottom = 8 + Caption = 'Post-Hoc Comparisons:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsHomogenousChildResize + ChildSizing.ShrinkVertical = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 115 + ClientWidth = 191 + TabOrder = 2 + object ScheffeChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 167 + Caption = 'ScheffeChk' + TabOrder = 0 + end + object TukeyHSDChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 167 + Caption = 'Tukey HSD (= n''s)' + TabOrder = 1 + end + object TukeyBChk: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 167 + Caption = 'Tukey B (= n''s)' + TabOrder = 2 + end + object TukeyKramerChk: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 167 + Caption = 'Tukey-Kramer' + TabOrder = 3 + end + object NewmanKeulsChk: TCheckBox + Left = 12 + Height = 19 + Top = 90 + Width = 167 + Caption = 'Newman-Keuls (= n''s)' + TabOrder = 4 + end + end + object Label3: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = OverAllAlpha + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = OverAllAlpha + Left = 8 + Height = 15 + Top = 390 + Width = 147 + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Alpha Level for Overall Tests' + ParentColor = False + end + object OverAllAlpha: TEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = PostAlpha + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 163 + Height = 23 + Top = 386 + Width = 51 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + TabOrder = 4 + Text = 'OverAllAlpha' + end + object Label4: TLabel + AnchorSideLeft.Control = OverAllAlpha + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = PostAlpha + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = PostAlpha + Left = 238 + Height = 15 + Top = 390 + Width = 163 + BorderSpacing.Left = 24 + BorderSpacing.Right = 8 + Caption = 'Alpha Level for Post-Hoc Tests:' + ParentColor = False + end + object PostAlpha: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrCenter + AnchorSideBottom.Control = Bevel1 + Left = 409 + Height = 23 + Top = 386 + Width = 51 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + TabOrder = 5 + Text = 'PostAlpha' + end + object HelpBtn: TButton + Tag = 107 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 295 + Height = 25 + Top = 425 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 6 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 354 + Height = 25 + Top = 425 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 7 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 416 + Height = 25 + Top = 425 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 8 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 500 + Height = 25 + Top = 425 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 9 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 409 + Width = 567 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object InteractBtn: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrBottom + Left = 380 + Height = 19 + Top = 297 + Width = 103 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + BorderSpacing.Bottom = 8 + Caption = 'Get Interactions' + TabOrder = 3 + end + object PlotOptionsBox: TRadioGroup + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 364 + Height = 114 + Top = 16 + Width = 195 + Anchors = [akTop, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + Caption = 'Plot Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 94 + ClientWidth = 191 + ItemIndex = 0 + Items.Strings = ( + 'no plot' + 'Plot with Vertical 3D Bars' + 'Plot with Vertical 2D Bars' + 'Plot with Horizontal 2D Bars' + ) + TabOrder = 1 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = PlotOptionsBox + AnchorSideBottom.Control = OverAllAlpha + Left = 8 + Height = 370 + Top = 8 + Width = 340 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 370 + ClientWidth = 340 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 49 + Caption = 'Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepIn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 353 + Top = 17 + Width = 187 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object DepIn: TBitBtn + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + Left = 195 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInClick + Spacing = 0 + TabOrder = 1 + end + object StaticText1: TStaticText + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = DepVar + Left = 231 + Height = 16 + Top = 24 + Width = 103 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + TabOrder = 3 + end + object DepOut: TBitBtn + AnchorSideLeft.Control = DepIn + AnchorSideTop.Control = DepIn + AnchorSideTop.Side = asrBottom + Left = 195 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutClick + Spacing = 0 + TabOrder = 2 + end + object Fact1In: TBitBtn + AnchorSideLeft.Control = DepIn + AnchorSideTop.Control = DepOut + AnchorSideTop.Side = asrBottom + Left = 195 + Height = 28 + Top = 101 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Fact1InClick + Spacing = 0 + TabOrder = 5 + end + object Fact1Out: TBitBtn + AnchorSideLeft.Control = DepIn + AnchorSideTop.Control = Fact1In + AnchorSideTop.Side = asrBottom + Left = 195 + Height = 28 + Top = 133 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Fact1OutClick + Spacing = 0 + TabOrder = 6 + end + object Fact2In: TBitBtn + AnchorSideLeft.Control = DepIn + AnchorSideTop.Control = Fact1Out + AnchorSideTop.Side = asrBottom + Left = 195 + Height = 28 + Top = 185 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Fact2InClick + Spacing = 0 + TabOrder = 9 + end + object Fact2Out: TBitBtn + AnchorSideLeft.Control = DepIn + AnchorSideTop.Control = Fact2In + AnchorSideTop.Side = asrBottom + Left = 195 + Height = 28 + Top = 217 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Fact2OutClick + Spacing = 0 + TabOrder = 10 + end + object StaticText2: TStaticText + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Factor1 + Left = 231 + Height = 16 + Top = 108 + Width = 87 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor 1 Variable' + TabOrder = 7 + end + object Factor1: TEdit + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Fact1Out + AnchorSideBottom.Side = asrBottom + Left = 231 + Height = 23 + Top = 126 + Width = 109 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 8 + Text = 'Edit1' + end + object StaticText3: TStaticText + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Factor2 + Left = 231 + Height = 16 + Top = 192 + Width = 87 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor 2 Variable' + TabOrder = 11 + end + object Factor2: TEdit + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Fact2Out + AnchorSideBottom.Side = asrBottom + Left = 231 + Height = 23 + Top = 210 + Width = 109 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 12 + Text = 'Edit1' + end + object Fact3In: TBitBtn + AnchorSideLeft.Control = DepIn + AnchorSideTop.Control = Fact2Out + AnchorSideTop.Side = asrBottom + Left = 195 + Height = 28 + Top = 269 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Fact3InClick + Spacing = 0 + TabOrder = 13 + end + object Fact3Out: TBitBtn + AnchorSideLeft.Control = DepIn + AnchorSideTop.Control = Fact3In + AnchorSideTop.Side = asrBottom + Left = 195 + Height = 28 + Top = 301 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Fact3OutClick + Spacing = 0 + TabOrder = 14 + end + object StaticText4: TStaticText + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Factor3 + Left = 231 + Height = 16 + Top = 276 + Width = 72 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Factor 3 Clark' + TabOrder = 15 + end + object Factor3: TEdit + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Fact3Out + AnchorSideBottom.Side = asrBottom + Left = 231 + Height = 23 + Top = 294 + Width = 109 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 16 + Text = 'Edit1' + end + object DepVar: TEdit + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOut + AnchorSideBottom.Side = asrBottom + Left = 231 + Height = 23 + Top = 42 + Width = 109 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 4 + Text = 'DepVar' + end + object Bevel2: TBevel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel1 + Left = 145 + Height = 17 + Top = 0 + Width = 50 + Shape = bsSpacer + end + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/onecaseanovaunit.pas b/applications/lazstats/source/forms/analysis/comparisons/onecaseanovaunit.pas new file mode 100644 index 000000000..fcc2f5f8e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/onecaseanovaunit.pas @@ -0,0 +1,2009 @@ +unit OneCaseANOVAUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, FunctionsLib, OutputUnit, DataProcs, GraphLib, + ANOVATestsUnit, contexthelpunit; + +type + + { TOneCaseAnovaForm } + + TOneCaseAnovaForm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + ComputeBtn: TButton; + DepIn: TBitBtn; + DepOut: TBitBtn; + DepVar: TEdit; + Fact1In: TBitBtn; + Fact1Out: TBitBtn; + Fact2In: TBitBtn; + Fact2Out: TBitBtn; + Fact3In: TBitBtn; + Fact3Out: TBitBtn; + Factor1: TEdit; + Factor2: TEdit; + Factor3: TEdit; + GroupBox1: TGroupBox; + InteractBtn: TCheckBox; + HelpBtn: TButton; + Label1: TLabel; + Label3: TLabel; + Label4: TLabel; + NewmanKeulsChk: TCheckBox; + OverAllAlpha: TEdit; + Panel1: TPanel; + PostAlpha: TEdit; + PlotOptionsBox: TRadioGroup; + ResetBtn: TButton; + CloseBtn: TButton; + ScheffeChk: TCheckBox; + StaticText1: TStaticText; + StaticText2: TStaticText; + StaticText3: TStaticText; + StaticText4: TStaticText; + TukeyBChk: TCheckBox; + TukeyHSDChk: TCheckBox; + TukeyKramerChk: TCheckBox; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure DepInClick(Sender: TObject); + procedure DepOutClick(Sender: TObject); + procedure Fact1InClick(Sender: TObject); + procedure Fact1OutClick(Sender: TObject); + procedure Fact2InClick(Sender: TObject); + procedure Fact2OutClick(Sender: TObject); + procedure Fact3InClick(Sender: TObject); + procedure Fact3OutClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + + private + { private declarations } + FAutoSized: Boolean; + NoSelected, N: integer; + ColNoSelected: IntDyneVec; + DepVarCol, F1Col, F2Col, F3Col, Nf1cells, Nf2cells, Nf3cells: integer; + minf1, maxf1, minf2, maxf2, minf3, maxf3, nofactors, totcells: integer; + NoGrpsA, NoGrpsB, NoGrpsC: integer; + SSDep, SSErr, SSF1, SSF2, SSF3, SSF1F2, SSF1F3, SSF2F3, SSF1F2F3: double; + MSDep, MSErr, MSF1, MSF2, MSF3, MSF1F2, MSF1F3, MSF2F3: double; + DFTot, DFErr, DFF1, DFF2, DFF3, DFF1F2, DFF1F3, DFF2F3: double; + Omega, OmegaF1, OmegaF2, OmegaF3, OmegaF1F2: double; + OmegaF1F3, OmegaF2F3: double; + FF1, FF2, FF1F2, ProbF1, ProbF2, ProbF3, ProbF1F2, ProbF1F3: double; + FF3, FF2F3, FF1F3, ProbF2F3: double; + MeanDep, MeanF1, MeanF2, MeanF3: double; + SSNonAdd, SSBalance,MSNonAdd, MSBalance, GrandMean, DFBalance: double; + FNonAdd, ProbNonAdd: double; + cellcnts : DblDyneVec; // array of cell counts + cellvars : DblDyneVec; // arrray of cell sums of squares then variances + cellsums : DblDyneVec; // array of cell sums then means + counts : DblDyneMat; // matrix for 2-way containing cell sizes + sums : DblDyneMat; // matrix for 2-way containing cell sums + vars : DblDyneMat; // matrix for 2-way containing sums of squares + RowSums : DblDyneVec; // 2 way row sums + ColSums : DblDyneVec; // 2 way col sums + RowCount : DblDyneVec; // 2 way row count + ColCount : DblDyneVec; // 2 way col count + SlcSums : DblDyneVec; // 3 way slice sums + SlcCount : DblDyneVec; // 3 way slice counts + OrdMeansA, OrdMeansB, OrdMeansC : DblDyneVec; // reordered means for f1, f2, f3 + OverAll, PostHocAlpha : double; // alphas for tests + wsum, wx2 : DblDyneCube; // : DblDyneCube + ncnt : IntDyneCube; // : IntDyneCube; + CompError : boolean; + equal_grp : boolean; // check for equal groups for post-hoc tests + comparisons : boolean; +// interacts : boolean; // true if 2 way interactions to be included in 3 way design + + procedure Init; + procedure GetLevels; + procedure Calc2Way; + procedure TwoWayTable(AReport: TStrings); + procedure TwoWayContrasts(AReport: TStrings); + procedure TwoWayPlot; + procedure Calc3Way; + procedure ThreeWayTable(AReport: TStrings); + procedure ThreeWayContrasts(AReport: TStrings); + procedure ThreeWayPlot; + + procedure UpdateBtnStates; + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + + public + { public declarations } + end; + +var + OneCaseAnovaForm: TOneCaseAnovaForm; + +implementation + +uses + Math; + +{ TOneCaseAnovaForm } + +procedure TOneCaseAnovaForm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + DepVar.Text := ''; + Factor1.Text := ''; + Factor2.Text := ''; + Factor3.Text := ''; + //PlotMeans.Checked := false; + ScheffeChk.Checked := false; + TukeyHSDChk.Checked := false; + TukeyBChk.Checked := false; + TukeyKramerChk.Checked := false; + NewmanKeulsChk.Checked := false; +// BonferroniChk.Checked := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TOneCaseAnovaForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Panel1.Constraints.MinWidth := 2*PlotoptionsBox.Width; + Constraints.MinHeight := Height; + Constraints.MinWidth := Width; + + FAutoSized := true; +end; + +procedure TOneCaseAnovaForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); + + OverallAlpha.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL); + PostAlpha.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL); +end; + +procedure TOneCaseAnovaForm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TOneCaseAnovaForm.DepInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepVar.Text = '') then + begin + DepVar.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TOneCaseAnovaForm.DepOutClick(Sender: TObject); +begin + if DepVar.Text <> '' then + begin + VarList.Items.Add(DepVar.Text); + DepVar.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TOneCaseAnovaForm.Fact1InClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (Factor1.Text = '') then + begin + Factor1.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TOneCaseAnovaForm.Fact1OutClick(Sender: TObject); +begin + if Factor1.Text <> '' then + begin + VarList.Items.Add(Factor1.Text); + Factor1.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TOneCaseAnovaForm.Fact2InClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (Factor2.Text = '') then + begin + Factor2.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TOneCaseAnovaForm.Fact2OutClick(Sender: TObject); +begin + if Factor2.Text <> '' then + begin + VarList.Items.Add(Factor2.Text); + Factor2.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TOneCaseAnovaForm.Fact3InClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (Factor3.Text = '') then + begin + Factor3.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TOneCaseAnovaForm.Fact3OutClick(Sender: TObject); +begin + if Factor3.Text <> '' then + begin + VarList.Items.Add(Factor3.Text); + Factor3.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TOneCaseAnovaForm.ComputeBtnClick(Sender: TObject); +var + lReport: TStrings; + msg: String; + C: TWinControl; +begin + NoFactors := 0; + if (Factor1.Text <> '') and (Factor2.Text <> '') then + begin + NoFactors := 2; + if (Factor3.Text <> '') then + NoFactors := 3; + end; + if (NoFactors < 2) then + begin + MessageDlg('Selection of 2 or 3 factors required.', mtError, [mbOK], 0); + exit; + end; + + if not Validate(msg, C) then begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + exit; + end; + + // initialize values + Init; + + // get min and max of each factor code + GetLevels; + + // Analysis + case NoFactors of + 2 : begin // two-way anova + SetLength(counts, Nf1cells, Nf2cells); // matrix for 2-way containing cell sizes + SetLength(sums, Nf1cells, Nf2cells); // matrix for 2-way containing cell sums + SetLength(vars, Nf1cells, Nf2cells); // matrix for 2-way containing sums of squares + SetLength(RowSums, Nf1cells); // 2 way row sums + SetLength(ColSums, Nf2cells); // 2 way col sums + SetLength(RowCount, Nf1cells); // 2 way row count + SetLength(ColCount, Nf2cells); // 2 way col count + SetLength(OrdMeansA, Nf1cells); // ordered means for factor 1 + SetLength(OrdMeansB, Nf2cells); // ordered means for factor 2 + Calc2Way; + if not CompError then + begin + lReport := TStringList.Create; + try + TwoWayTable(lReport); + TwoWayContrasts(lReport); + DisplayReport(lReport); + if PlotOptionsBox.ItemIndex > 0 then + TwoWayPlot; + finally + lReport.Free; + end; + end; + vars := nil; + sums := nil; + counts := nil; + end; + + 3 : begin // three way anova + SetLength(RowSums, Nf1cells); // 2 way row sums + SetLength(ColSums, Nf2cells); // 2 way col sums + SetLength(RowCount, Nf1cells); // 2 way row count + SetLength(ColCount, Nf2cells); // 2 way col count + SetLength(SlcSums, Nf3cells); // 3 way slice sums + SetLength(SlcCount, Nf3cells); // 3 way slice counts + SetLength(OrdMeansA, Nf1cells); // ordered means for factor 1 + SetLength(OrdMeansB, Nf2cells); // ordered means for factor 2 + SetLength(OrdMeansC, Nf3cells); // ordered means for factor 3 + SetLength(wsum, Nf1cells, Nf2cells, Nf3cells); + SetLength(wx2, Nf1cells, Nf2cells, Nf3cells); + SetLength(ncnt, Nf1cells, Nf2cells, Nf3cells); + Calc3Way; + if not CompError then + begin + lReport := TStringList.Create; + try + ThreeWayTable(lReport); + ThreeWayContrasts(lReport); + DisplayReport(lReport); + if PlotOptionsBox.ItemIndex > 0 then + ThreeWayPlot; + finally + lReport.Free; + end; + ncnt := nil; + wx2 := nil; + wsum := nil; + OrdMeansC := nil; + SlcCount := nil; + SlcSums := nil; + end; + end; + end; // end switch + + cellcnts := nil; + cellvars := nil; + cellsums := nil; + ColNoSelected := nil; + OrdMeansB := nil; + OrdMeansA := nil; + ColCount := nil; + RowCount := nil; + ColSums := nil; + RowSums := nil; +end; + +procedure TOneCaseAnovaForm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TOneCaseAnovaForm.Init; +var + i: Integer; + cellstring: String; +begin + comparisons := ScheffeChk.Checked or TukeyHSDChk.Checked or + TukeyBChk.Checked or TukeyKramerChk.Checked or NewmanKeulsChk.Checked; + + SetLength(ColNoSelected, NoVariables); + DepVarCol := 0; + F1Col := 0; + F2Col := 0; + F3Col := 0; + SSDep := 0.0; + SSF1 := 0.0; + SSF2 := 0.0; + SSF3 := 0.0; + SSF1F2 := 0.0; + SSF1F3 := 0.0; + SSF2F3 := 0.0; + SSF1F2F3 := 0.0; + MeanDep := 0.0; + MeanF1 := 0.0; + MeanF2 := 0.0; + MeanF3 := 0.0; + Nf1cells := 0; + Nf2cells := 0; + Nf3cells := 0; + //N := 0; + NoSelected := 0; + minf1 := 0; + maxf1 := 0; + minf2 := 0; + maxf2 := 0; + minf3 := 0; + maxf3 := 0; + + // Get column numbers of dependent variable and factors + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = DepVar.Text) then + begin + DepVarCol := i; + NoSelected := NoSelected + 1; + ColNoSelected[NoSelected-1] := DepVarCol; + end else + if (cellstring = Factor1.Text) then + begin + F1Col := i; + NoSelected := NoSelected + 1; + ColNoSelected[NoSelected-1] := F1Col; + end else + if (cellstring = Factor2.Text) then + begin + F2Col := i; + NoSelected := NoSelected + 1; + ColNoSelected[NoSelected-1] := F2Col; + end else + if (cellstring = Factor3.Text) then + begin + F3Col := i; + NoSelected := NoSelected + 1; + ColNoSelected[NoSelected-1] := F3Col; + end; + end; + OverAll := StrToFloat(OverAllAlpha.Text); + PostHocAlpha := StrToFloat(PostAlpha.Text); + end; + +procedure TOneCaseAnovaForm.GetLevels; +var + i: integer; + intValue: Integer; +begin + minf1 := ceil(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,1]))); + maxf1 := minf1; + for i := 2 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intValue := floor(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]))); + if (intValue > maxf1) then maxf1 := intValue; + if (intValue < minf1) then minf1 := intValue; + end; + Nf1cells := maxf1 - minf1 + 1; + + if (nofactors > 1) then + begin + minf2 := floor(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F2Col,1]))); + maxf2 := minf2; + for i := 2 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intValue := floor(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F2Col,i]))); + if (intValue > maxf2) then maxf2 := intValue; + if (intValue < minf2) then minf2 := intValue; + end; + Nf2cells := maxf2 - minf2 + 1; + end; + + if (nofactors = 3) then + begin + minf3 := floor(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F3Col,1]))); + maxf3 := minf3; + for i := 2 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intValue := floor(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F3Col,i]))); + if (intValue > maxf3) then maxf3 := intValue; + if (intValue < minf3) then minf3 := intValue; + end; + Nf3cells := maxf3 - minf3 + 1; + end; + + totcells := Nf1cells + Nf2cells + Nf3cells; + + // allocate space + SetLength(cellcnts, totcells); // array of cell counts + SetLength(cellvars, totcells); // arrray of cell sums of squares variances + SetLength(cellsums, totcells); // array of cell sums means + + // initialize array values + for i := 1 to totcells do + begin + cellsums[i-1] := 0.0; + cellvars[i-1] := 0.0; + cellcnts[i-1] := 0; + end; +end; + +procedure TOneCaseAnovaForm.Calc2Way; +var + i, j, grpA, grpB: integer; + Constant, RowsTotCnt, ColsTotCnt, SSCells: double; + X, rowMean, colmean: Double; +begin + CompError := false; + + // initialize matrix values + NoGrpsA := maxf1 - minf1 + 1; + NoGrpsB := maxf2 - minf2 + 1; + for i := 1 to NoGrpsA do + begin + RowSums[i-1] := 0.0; + RowCount[i-1] := 0.0; + for j := 1 to NoGrpsB do + begin + counts[i-1,j-1] := 0.0; + sums[i-1,j-1] := 0.0; + vars[i-1,j-1] := 0.0; + end; + end; + + for i := 1 to NoGrpsB do + begin + ColCount[i-1] := 0.0; + ColSums[i-1] := 0.0; + end; + + N := 0; + MeanDep := 0.0; + SSDep := 0.0; + SSCells := 0.0; + RowsTotCnt := 0.0; + ColsTotCnt := 0.0; + SSNonAdd := 0.0; + SSBalance := 0.0; + MSNonAdd := 0.0; + MSBalance := 0.0; + + // get working totals + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + grpA := floor(StrToFloat(OS3MainFrm.DataGrid.Cells[F1Col,i])); + grpB := floor(StrToFloat(OS3MainFrm.DataGrid.Cells[F2Col,i])); + X := StrToFloat(OS3MainFrm.DataGrid.Cells[DepVarCol,i]); + grpA := grpA - minf1 + 1; + grpB := grpB - minf2 + 1; + counts[grpA-1,grpB-1] := counts[grpA-1,grpB-1] + 1; + sums[grpA-1,grpB-1] := sums[grpA-1,grpB-1] + X; + vars[grpA-1,grpB-1] := vars[grpA-1,grpB-1] + X * X; + RowSums[grpA-1] := RowSums[grpA-1] + X; + ColSums[grpB-1] := ColSums[grpB-1] + X; + RowCount[grpA-1] := RowCount[grpA-1] + 1.0; + ColCount[grpB-1] := ColCount[grpB-1] + 1.0; + MeanDep := MeanDep + X; + SSDep := SSDep + X * X; + N := N + 1; + end; + + // Calculate results + for i := 0 to NoGrpsA - 1 do + begin + SSF1 := SSF1 + sqr(RowSums[i]) / RowCount[i]; + RowsTotCnt := RowsTotCnt + RowCount[i]; + end; + for j := 0 to NoGrpsB - 1 do + begin + SSF2 := SSF2 + sqr(ColSums[j]) / ColCount[j]; + ColsTotCnt := ColsTotCnt + ColCount[j]; + end; + + GrandMean := MeanDep / N; + + for i := 0 to NoGrpsA - 1 do + begin + rowmean := RowSums[i] / RowCount[i]; + for j := 0 to NoGrpsB - 1 do + begin + colmean := ColSums[j] / ColCount[j]; + SSNonAdd := SSNonAdd + (colmean - GrandMean) * (rowmean - GrandMean) * sums[i,j]; + end; + end; + + if (N > 0) then + Constant := (MeanDep * MeanDep) / N + else + Constant := 0.0; + SSF1 := SSF1 - Constant; + SSF2 := SSF2 - Constant; + SSDep := SSDep - Constant; + SSErr := SSDep - (SSF1 + SSF2); + SSNonAdd := (SSNonAdd * SSNonAdd) / ((SSF1 * SSF2) / (NoGrpsA * NoGrpsB) ); + MSNonAdd := SSNonAdd; + SSBalance := SSErr - SSNonAdd; + if ((SSF1 < 0) or (SSF2 < 0)) then + begin + MessageDlg('A negative SS found. Unbalanced design? Ending analysis.', mtInformation, [mbOK], 0); + CompError := true; + exit; + end; + + DFTot := N - 1; + DFF1 := NoGrpsA - 1; + DFF2 := NoGrpsB - 1; + DFErr := DFF1 * DFF2; + DFBalance := DFErr - 1; + MSF1 := SSF1 / DFF1; + MSF2 := SSF2 / DFF2; + MSErr := SSErr / DFErr; + MSDep := SSDep / DFTot; + MSBalance := SSBalance / DFBalance; + OmegaF1 := (SSF1 - DFF1 * MSErr) / (SSDep + MSErr); + OmegaF2 := (SSF2 - DFF2 * MSErr) / (SSDep + MSErr); + Omega := OmegaF1 + OmegaF2; + MeanDep := MeanDep / N; + + // F tests for fixed effects + FF1 := abs(MSF1 / MSErr); + FF2 := abs(MSF2 / MSErr); + if (MSBalance > 0.0) then + FNonAdd := MSNonAdd / MSBalance + else + FNonAdd := 0.0; + ProbF1 := probf(FF1,DFF1,DFErr); + ProbF2 := probf(FF2,DFF2,DFErr); + ProbNonAdd := probf(FNonAdd,1.0,DFBalance); + if (ProbF1 > 1.0) then ProbF1 := 1.0; + if (ProbF2 > 1.0) then ProbF2 := 1.0; + + // Obtain omega squared (proportion of dependent variable explained) + if (OmegaF1 < 0.0) then OmegaF1 := 0.0; + if (OmegaF2 < 0.0) then OmegaF2 := 0.0; + if (Omega < 0.0) then Omega := 0.0; +end; + +procedure TOneCaseAnovaForm.TwoWayTable(AReport: TStrings); +var + i, j, groupsize: integer; + MinVar, MaxVar, sumvars, sumDFrecip, XBar, V, S, RowSS, ColSS: double; + sumfreqlogvar: double; +begin + if CompError then + exit; + + AReport.Add('TWO-WAY ANALYSIS OF VARIANCE'); + AReport.Add(''); + AReport.Add('Variable analyzed: %s', [DepVar.Text]); + AReport.Add(''); + AReport.Add('Factor A (rows) variable: %s', [Factor1.Text]); + AReport.Add('Factor B (columns) variable: %s', [Factor2.Text]); + AReport.Add(''); + AReport.Add('SOURCE D.F. SS MS F PROB.> F Omega Squared'); + AReport.Add(''); + AReport.Add('Among Rows %4.0f %8.3f %8.3f %8.3f %6.3f %6.3f', [DFF1, SSF1, MSF1, FF1, ProbF1, OmegaF1]); + AReport.Add('Among Columns %4.0f %8.3f %8.3f %8.3f %6.3f %6.3f', [DFF2, SSF2, MSF2, FF2, ProbF2, OmegaF2]); + AReport.Add('Residual %4.0f %8.3f %8.3f', [DFErr, SSErr, MSErr]); + AReport.Add(' NonAdditivity %4.0f %8.3f %8.3f %8.3f %6.3f', [1.0, SSNonAdd, MSNonAdd, FNonAdd, ProbNonAdd]); + AReport.Add(' Balance %4.0f %8.3f %8.3f', [DFBalance, SSBalance, MSBalance]); + AReport.Add('Total %4.0f %8.3f %8.3f', [DFTot, SSDep, MSDep]); + AReport.Add(''); + AReport.Add('Omega squared for combined effects = %8.3f', [Omega]); + AReport.Add(''); + AReport.Add('Descriptive Statistics'); + AReport.Add(''); + AReport.Add('GROUP Row Col. N MEAN VARIANCE STD.DEV.'); + + groupsize := ceil(counts[0,0]); + equal_grp := true; + MaxVar := -1e308; + MinVar := 1e308; + sumvars := 0.0; + sumfreqlogvar := 0.0; + sumDFrecip := 0.0; + + // Display cell means, variances, standard deviations + V := 0.0; + XBar := 0.0; + S := 0.0; + for i := 0 to NoGrpsA - 1 do + begin + for j := 0 to NoGrpsB - 1 do + begin + if (counts[i,j] > 1) then + begin + XBar := sums[i][j] / counts[i,j]; + V := vars[i][j] - sqr(sums[i,j]) / counts[i,j]; + V := V / (counts[i,j] - 1.0); + S := sqrt(V); + sumvars := sumvars + V; + if (V > MaxVar) then MaxVar := V; + if (V < MinVar) then MinVar := V; + sumDFrecip := sumDFrecip + 1.0 / (counts[i,j] - 1.0); + sumfreqlogvar := sumfreqlogvar + (counts[i,j] - 1.0) * ln(V); + if (counts[i,j] <> groupsize) then equal_grp := false; + end + else + XBar := sums[i][j]; + AReport.Add('Cell %3d %3d %3.0f %8.3f %8.3f %8.3f', [minf1+i, minf2+j, counts[i,j], XBar, V, S]); + end; + end; + + //Display Row means, variances, standard deviations + for i := 0 to NoGrpsA - 1 do + begin + XBar := RowSums[i] / RowCount[i]; + OrdMeansA[i] := XBar; + RowSS := 0.0; + for j := 0 to NoGrpsB - 1 do RowSS := RowSS + vars[i,j]; + V := RowSS - sqr(RowSums[i]) / RowCount[i]; + V := V / (RowCount[i] - 1.0); + S := sqrt(V); + AReport.Add('Row %3d %3.0f %8.3f %8.3f %8.3f', [minf1+i, RowCount[i], XBar, V, S]); + end; + + //Display means, variances and standard deviations for columns + for j := 0 to NoGrpsB - 1 do + begin + XBar := ColSums[j] / ColCount[j]; + OrdMeansB[j] := XBar; + ColSS := 0.0; + for i := 0 to NoGrpsA - 1 do ColSS := ColSS + vars[i,j]; + if (ColCount[j] > 0) then V := ColSS - sqr(ColSums[j]) / ColCount[j]; + if (ColCount[j] > 1) then V := V / (ColCount[j] - 1.0); + if (V > 0.0) then S := sqrt(V); + AReport.Add('Col %3d %3.0f %8.3f %8.3f %8.3f', [minf2+j, ColCount[j], XBar, V, S]); + end; + + AReport.Add('TOTAL %3d %8.3f %8.3f %8.3f', [N, MeanDep, MSDep, sqrt(MSDep)]); + AReport.Add(''); +end; + +procedure TOneCaseAnovaForm.TwoWayPlot; +var + i, j: integer; + maxmean, XBar: double; + XValue: DblDyneVec; + plottype: integer; +begin + if CompError then + exit; + + case PlotOptionsBox.ItemIndex of + 0: exit; + 1: plotType := 2; // 3D bars + 2: plotType := 1; // 2D bars + 3: plotType := 9; // 2D horizontal bars + else raise Exception.Create('Plot type not supported.'); + end; + + SetLength(XValue, Nf1cells+Nf2cells); + + // Factor A first + GraphFrm.SetLabels[1] := 'FACTOR A'; + maxmean := 0.0; + SetLength(GraphFrm.Xpoints, 1, Nf1cells); + SetLength(GraphFrm.Ypoints, 1, Nf1cells); + for i := 1 to Nf1cells do + begin + RowSums[i-1] := RowSums[i-1] / RowCount[i-1]; + GraphFrm.Ypoints[0,i-1] := RowSums[i-1]; + if (RowSums[i-1] > maxmean) then maxmean := RowSums[i-1]; + XValue[i-1] := minf1 + i - 1; + GraphFrm.Xpoints[0,i-1] := XValue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := Nf1cells; + GraphFrm.Heading := Factor1.Text; + GraphFrm.XTitle := Factor1.Text + ' Codes'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal(); + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + + // Factor B next + GraphFrm.SetLabels[1] := 'FACTOR B'; + maxmean := 0.0; + SetLength(GraphFrm.Xpoints, 1, Nf2cells); + SetLength(GraphFrm.Ypoints, 1, Nf2cells); + for i := 1 to Nf2cells do + begin + ColSums[i-1] := ColSums[i-1] / ColCount[i-1]; + GraphFrm.Ypoints[0,i-1] := ColSums[i-1]; + if (ColSums[i-1] > maxmean) then maxmean := ColSums[i-1]; + XValue[i-1] := minf1 + i - 1; + GraphFrm.Xpoints[0,i-1] := XValue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := Nf2cells; + GraphFrm.Heading := Factor2.Text; + GraphFrm.XTitle := FActor2.Text + ' Codes'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal(); + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + + // Factor A x B Interaction next + maxmean := 0.0; + SetLength(GraphFrm.Ypoints, Nf1cells, Nf2cells); + SetLength(GraphFrm.Xpoints, 1, Nf2cells); + for i := 1 to Nf1cells do + begin + GraphFrm.SetLabels[i] := Factor1.Text + ' ' + IntToStr(i); + for j := 1 to Nf2cells do + begin + XBar := sums[i-1,j-1] / counts[i-1,j-1]; + if (XBar > maxmean) then maxmean := XBar; + GraphFrm.Ypoints[i-1,j-1] := XBar; + end; + end; + for j := 1 to Nf2cells do + begin + XValue[j-1] := minf2 + j - 1; + GraphFrm.Xpoints[0,j-1] := XValue[j-1]; + end; + GraphFrm.nosets := Nf1cells; + GraphFrm.nbars := Nf2cells; + GraphFrm.Heading := 'Factor A x Factor B'; + GraphFrm.XTitle := Factor2.Text + ' Codes'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal(); + XValue := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +procedure TOneCaseAnovaForm.Calc3Way; +var + i, j, k, grpA, grpB, grpC: integer; + Constant, RowsTotCnt, ColsTotCnt, SlcsTotCnt, SSCells, p, n2: double; + X, rowMean, colMean, sliceMean: Double; +begin + CompError := false; + + // initialize matrix values + NoGrpsA := maxf1 - minf1 + 1; + NoGrpsB := maxf2 - minf2 + 1; + NoGrpsC := maxf3 - minf3 + 1; + for i := 0 to NoGrpsA - 1 do + begin + RowSums[i] := 0.0; + RowCount[i] := 0.0; + for j := 0 to NoGrpsB - 1 do + begin + for k := 0 to NoGrpsC - 1 do + begin + wsum[i,j,k] := 0.0; + ncnt[i,j,k] := 0; + wx2[i,j,k] := 0.0; + end; + end; + end; + + for i := 0 to NoGrpsB - 1 do + begin + ColCount[i] := 0.0; + ColSums[i] := 0.0; + end; + + for i := 0 to NoGrpsC - 1 do + begin + SlcCount[i] := 0.0; + SlcSums[i] := 0.0; + end; + + N := 0; + MeanDep := 0.0; + SSDep := 0.0; + RowsTotCnt := 0.0; + ColsTotCnt := 0.0; + SlcsTotCnt := 0.0; + SSF1 := 0.0; + SSF2 := 0.0; + SSF3 := 0.0; + SSF1F2 := 0.0; + SSF1F3 := 0.0; + SSF2F3 := 0.0; + SSF1F2F3 := 0.0; + SSCells := 0.0; + SSNonAdd := 0.0; + + // get working totals + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + grpA := floor(StrToFloat(OS3MainFrm.DataGrid.Cells[F1Col,i])); + grpB := floor(StrToFloat(OS3MainFrm.DataGrid.Cells[F2Col,i])); + grpC := floor(StrToFloat(OS3MainFrm.DataGrid.Cells[F3Col,i])); + X := StrToFloat(OS3MainFrm.DataGrid.Cells[DepVarCol,i]); + grpA := grpA - minf1 + 1; + grpB := grpB - minf2 + 1; + grpC := grpC - minf3 + 1; + ncnt[grpA-1,grpB-1,grpC-1] := ncnt[grpA-1,grpB-1,grpC-1] + 1; + wsum[grpA-1,grpB-1,grpC-1] := wsum[grpA-1,grpB-1,grpC-1] + X; + wx2[grpA-1,grpB-1,grpC-1] := wx2[grpA-1,grpB-1,grpC-1] + X * X; + RowSums[grpA-1] := RowSums[grpA-1] + X; + ColSums[grpB-1] := ColSums[grpB-1] + X; + SlcSums[grpC-1] := SlcSums[grpC-1] + X; + RowCount[grpA-1] := RowCount[grpA-1] + 1.0; + ColCount[grpB-1] := ColCount[grpB-1] + 1.0; + SlcCount[grpC-1] := SlcCount[grpC-1] + 1.0; + MeanDep := MeanDep + X; + SSDep := SSDep + X * X; + N := N + 1; + end; + + // Calculate results + Constant := (MeanDep * MeanDep) / N; + GrandMean := MeanDep / N; + + // get ss for rows + for i := 0 to NoGrpsA - 1 do + begin + SSF1 := SSF1 + RowSums[i] * RowSums[i] / RowCount[i]; + RowsTotCnt := RowsTotCnt + RowCount[i]; + end; + SSF1 := SSF1 - Constant; + + // get ss for columns + for j := 0 to NoGrpsB - 1 do + begin + SSF2 := SSF2 + ColSums[j] * ColSums[j] / ColCount[j]; + ColsTotCnt := ColsTotCnt + ColCount[j]; + end; + SSF2 := SSF2 - Constant; + + // get ss for slices + for k := 0 to NoGrpsC - 1 do + begin + SSF3 := SSF3 + SlcSums[k] * SlcSums[k] / SlcCount[k]; + SlcsTotCnt := SlcsTotCnt + SlcCount[k]; + end; + SSF3 := SSF3 - Constant; + + // get ss for row x col interaction + p := 0.0; + n2 := 0.0; + for i := 0 to NoGrpsA - 1 do + begin + for j := 0 to NoGrpsB - 1 do + begin + for k := 0 to NoGrpsC - 1 do + begin + p := p + wsum[i,j,k]; + n2 := n2 + ncnt[i,j,k]; + end; + SSF1F2 := SSF1F2 + p * p / n2; + p := 0.0; + n2 := 0.0; + end; + end; + SSF1F2 := SSF1F2 - SSF1 - SSF2 - Constant; + + // get ss for row x slice interaction + for i := 0 to NoGrpsA - 1 do + begin + for k := 0 to NoGrpsC - 1 do + begin + for j := 0 to NoGrpsB - 1 do + begin + p := p + wsum[i,j,k]; + n2 := n2 + ncnt[i,j,k]; + end; + SSF1F3 := SSF1F3 + p * p / n2; + p := 0.0; + n2 := 0.0; + end; + end; + SSF1F3 := SSF1F3 - SSF1 - SSF3 - Constant; + + // get ss for columns x slices interaction + for j := 0 to NoGrpsB - 1 do + begin + for k := 0 to NoGrpsC - 1 do + begin + for i := 0 to NoGrpsA - 1 do + begin + p := p + wsum[i,j,k]; + n2 := n2 + ncnt[i,j,k]; + end; + SSF2F3 := SSF2F3 + p * p / n2; + p := 0.0; + n2 := 0.0; + end; + end; + SSF2F3 := SSF2F3 - SSF2 - SSF3 - Constant; + +(* + // get ss for cells + for (i := 0; i < NoGrpsA; i++) + for (j := 0; j < NoGrpsB; j++) + for (k := 0; k < NoGrpsC; k++) + SSCells := SSCells + ((wsum[i][j][k] * wsum[i][j][k]) / ncnt[i][j][k]); + + SSF1F2F3 := SSCells - SSF1 - SSF2 - SSF3 - SSF1F2 - SSF1F3 - SSF2F3 - Constant; +*) + + for i := 0 to NoGrpsA - 1 do + begin + rowmean := RowSums[i] / RowCount[i]; + for j := 0 to NoGrpsB - 1 do + begin + colmean := ColSums[j] / ColCount[j]; + for k := 0 to NoGrpsC - 1 do + begin + slicemean := SlcSums[k] / SlcCount[k]; + SSNonAdd := SSNonAdd + (colmean-GrandMean) * (rowmean-GrandMean) * (slicemean-GrandMean) * wsum[i,j,k]; + end; + end; + end; + + SSDep := SSDep - Constant; + if not InteractBtn.Checked then + SSErr := SSDep - (SSF1 + SSF2 + SSF3) + else + SSErr := SSDep - (SSF1 + SSF2 + SSF3 + SSF1F2 + SSF1F3 + SSF2F3); + SSNonAdd := SSNonAdd * SSNonAdd / (SSF1 * SSF2 * SSF3); + SSNonAdd := SSNonAdd * NoGrpsA * NoGrpsB * NoGrpsC * NoGrpsA * NoGrpsB * NoGrpsC; + MSNonAdd := SSNonAdd; + SSBalance := SSErr - SSNonAdd; + + if ((SSF1 < 0.0) or (SSF2 < 0.0) or (SSF3 < 0.0) or (SSF1F2 < 0.0) or (SSF1F3 < 0.0) or (SSF2F3 < 0.0)) then + begin + MessageDlg('A negative SS found. Unbalanced Design? Ending analysis.', mtInformation, [mbOK], 0); + CompError := true; + exit; + end; + + DFTot := N - 1; + DFF1 := NoGrpsA - 1; + DFF2 := NoGrpsB - 1; + DFF3 := NoGrpsC - 1; + DFF1F2 := DFF1 * DFF2; + DFF1F3 := DFF1 * DFF3; + DFF2F3 := DFF2 * DFF3; + if not InteractBtn.Checked then + DFErr := DFTot - DFF1 - DFF2 - DFF3 + else + DFErr := DFTot - DFF1 - DFF2 - DFF3 - DFF1F2 - DFF1F3 - DFF2F3; + DFBalance := DFErr - 1; + MSF1 := SSF1 / DFF1; + MSF2 := SSF2 / DFF2; + MSF3 := SSF3 / DFF3; + MSF1F2 := SSF1F2 / DFF1F2; + MSF1F3 := SSF1F3 / DFF1F3; + MSF2F3 := SSF2F3 / DFF2F3; + MSErr := SSErr / DFErr; + MSDep := SSDep / DFTot; + MSBalance := SSBalance / DFBalance; + OmegaF1 := (SSF1 - DFF1 * MSErr) / (SSDep + MSErr); + OmegaF2 := (SSF2 - DFF2 * MSErr) / (SSDep + MSErr); + OmegaF3 := (SSF3 - DFF3 * MSErr) / (SSDep + MSErr); + OmegaF1F2 := (SSF1F2 - DFF1F2 * MSErr) / (SSDep + MSErr); + OmegaF1F3 := (SSF1F3 - DFF1F3 * MSErr) / (SSDep + MSErr); + OmegaF2F3 := (SSF2F3 - DFF2F3 * MSErr) / (SSDep + MSErr); + if not InteractBtn.Checked then + Omega := OmegaF1 + OmegaF2 + OmegaF3 + else + Omega := OmegaF1 + OmegaF2 + OmegaF3 + OmegaF1F2 + OmegaF1F3 + OmegaF2F3; + MeanDep := MeanDep / N; + + FF1 := abs(MSF1 / MSErr); + FF2 := abs(MSF2 / MSErr); + FF3 := abs(MSF3 / MSErr); + FF1F2 := abs(MSF1F2 / MSErr); + FF1F3 := abs(MSF1F3 / MSErr); + FF2F3 := abs(MSF2F3 / MSErr); + if (MSBalance > 0.0) then + FNonAdd := MSNonAdd / MSBalance + else + FNonAdd := 0.0; + + ProbF1 := probf(FF1,DFF1,DFErr); + ProbF2 := probf(FF2,DFF2,DFErr); + ProbF3 := probf(FF3,DFF3,DFErr); + ProbF1F2 := probf(FF1F2,DFF1F2,DFErr); + ProbF1F3 := probf(FF1F3,DFF1F3,DFErr); + ProbF2F3 := probf(FF2F3,DFF2F3,DFErr); + ProbNonAdd := probf(FNonAdd,1.0,DFBalance); + + if (ProbF1 > 1.0) then ProbF1 := 1.0; + if (ProbF2 > 1.0) then ProbF2 := 1.0; + if (ProbF3 > 1.0) then ProbF3 := 1.0; + if (ProbF1F2 > 1.0) then ProbF1F2 := 1.0; + if (ProbF1F3 > 1.0) then ProbF1F3 := 1.0; + if (ProbF2F3 > 1.0) then ProbF2F3 := 1.0; + + // Obtain omega squared (proportion of dependent variable explained) + if (OmegaF1 < 0.0) then OmegaF1 := 0.0; + if (OmegaF2 < 0.0) then OmegaF2 := 0.0; + if (OmegaF3 < 0.0) then OmegaF3 := 0.0; + if (OmegaF1F2 < 0.0) then OmegaF1F2 := 0.0; + if (OmegaF1F3 < 0.0) then OmegaF1F3 := 0.0; + if (OmegaF2F3 < 0.0) then OmegaF2F3 := 0.0; + if (Omega < 0.0) then Omega := 0.0; +end; + +procedure TOneCaseAnovaForm.ThreeWayTable(AReport: TStrings); +var + i, j, k: integer; + XBar, V, S, RowSS, ColSS, SlcSS: double; +begin + if CompError then + exit; + + AReport.Add('THREE-WAY ANALYSIS OF VARIANCE'); + AReport.Add(''); + AReport.Add('Variable analyzed: %s', [DepVar.Text]); + AReport.Add(''); + AReport.Add('Factor A (rows) variable: %s', [Factor1.Text]); + AReport.Add('Factor B (columns) variable: %s', [Factor2.Text]); + AReport.Add('Factor C (slices) variable: %s', [Factor3.Text]); + AReport.Add(''); + AReport.Add('SOURCE D.F. SS MS F PROB.> F Omega Squared'); + AReport.Add(''); + AReport.Add('Among Rows %4.0f %12.4f %12.4f %12.4f %6.3f %6.3f', [DFF1, SSF1, MSF1, FF1, ProbF1, OmegaF1]); + AReport.Add('Among Columns %4.0f %12.4f %12.4f %12.4f %6.3f %6.3f', [DFF2, SSF2, MSF2, FF2, ProbF2, OmegaF2]); + AReport.Add('Among Slices %4.0f %12.4f %12.4f %12.4f %6.3f %6.3f', [DFF3, SSF3, MSF3, FF3, ProbF3, OmegaF3]); + + if InteractBtn.Checked then + begin + AReport.Add('A x B Inter. %4.0f %12.4f %12.4f %12.4f %6.3f %6.3f', [DFF1F2, SSF1F2, MSF1F2, FF1F2, ProbF1F2, OmegaF1F2]); + AReport.Add('A x C Inter. %4.0f %12.4f %12.4f %12.4f %6.3f %6.3f', [DFF1F3, SSF1F3, MSF1F3, FF1F3, ProbF1F3, OmegaF1F3]); + AReport.Add('B x C Inter. %4.0f %12.4f %12.4f %12.4f %6.3f %6.3f', [DFF2F3, SSF2F3, MSF2F3, FF2F3, ProbF2F3, OmegaF2F3]); + end; + AReport.Add('Residual %4.0f %12.4f %12.4f', [DFErr, SSErr, MSErr]); + AReport.Add(' NonAdditivity %4.0f %12.4f %12.4f %12.4f %6.3f', [1.0, SSNonAdd, MSNonAdd, FNonAdd, ProbNonAdd]); + AReport.Add(' Balance %4.0f %12.4f %12.4f', [DFBalance, SSBalance, MSBalance]); + AReport.Add('Total %4.0f %12.4f %12.4f', [DFTot, SSDep, MSDep]); + AReport.Add(''); + AReport.Add('Omega squared for combined effects := %8.4f', [Omega]); + AReport.Add(''); + AReport.Add(''); + AReport.Add('Descriptive Statistics'); + AReport.Add(''); + AReport.Add('GROUP N MEAN VARIANCE STD.DEV.'); + equal_grp := true; + + // Display cell means, variances, standard deviations + for i := 0 to NoGrpsA - 1 do + begin + for j := 0 to NoGrpsB - 1 do + begin + for k := 0 to NoGrpsC - 1 do + begin + XBar := wsum[i,j,k] / ncnt[i,j,k]; // wp: why this? Result is not used and overwritten in next loop. + V := 0.0; // dto. + S := 0.0; // dto. + end; + end; + end; + + //Display Row means, variances, standard deviations + for i := 0 to NoGrpsA - 1 do + begin + XBar := RowSums[i] / RowCount[i]; + OrdMeansA[i] := XBar; + RowSS := 0.0; + for j := 0 to NoGrpsB - 1 do + for k := 0 to NoGrpsC - 1 do + RowSS := RowSS + wx2[i,j,k]; + V := RowSS - (RowSums[i] * RowSums[i] / RowCount[i]); + V := V / (RowCount[i] - 1.0); + S := sqrt(V); + AReport.Add('Row %3d %3.0f %8.3f %8.3f %8.3f', [minf1+i, RowCount[i], XBar, V, S]); + end; + + //Display means, variances and standard deviations for columns + for j := 0 to NoGrpsB - 1 do + begin + XBar := ColSums[j] / ColCount[j]; + OrdMeansB[j] := XBar; + ColSS := 0.0; + for i := 0 to NoGrpsA - 1 do + for k := 0 to NoGrpsC - 1 do + ColSS := ColSS + wx2[i,j,k]; + V := ColSS - (ColSums[j] * ColSums[j] / ColCount[j]); + V := V / (ColCount[j] - 1.0); + S := sqrt(V); + AReport.Add('Col %3d %3.0f %8.3f %8.3f %8.3f', [minf2+j, ColCount[j], XBar, V, S]); + end; + + //Display means, variances and standard deviations for slices + for k := 0 to NoGrpsC - 1 do + begin + XBar := SlcSums[k] / SlcCount[k]; + OrdMeansC[k] := XBar; + SlcSS := 0.0; + for i := 0 to NoGrpsA - 1 do + for j := 0 to NoGrpsB - 1 do + SlcSS := SlcSS + wx2[i,j,k]; + V := SlcSS - (SlcSums[k] * SlcSums[k] / SlcCount[k]); + V := V / (SlcCount[k] - 1.0); + S := sqrt(V); + AReport.Add('Slice %3d %3.0f %8.3f %8.3f %8.3f', [minf3+k, SlcCount[k], XBar, V, S]); + end; + + AReport.Add('TOTAL %3d %8.3f %8.3f %8.3f', [N, MeanDep, MSDep, sqrt(MSDep)]); + AReport.Add(''); + AReport.Add(''); +end; + +procedure TOneCaseAnovaForm.ThreeWayPlot; +var + i, j, k: integer; + maxmean, XBar: double; + XValue: DblDyneVec; + plottype: integer; +begin + if CompError then + exit; + + case PlotOptionsBox.ItemIndex of + 0: exit; + 1: plotType := 2; // 3D bars + 2: plotType := 1; // 2D bars + 3: plotType := 9; // 2D horizontal bars + else raise Exception.Create('Plot type not supported.'); + end; + + SetLength(XValue,totcells); + + // Factor A first + GraphFrm.SetLabels[1] := 'FACTOR A'; + maxmean := 0.0; + SetLength(GraphFrm.Xpoints, 1, Nf1cells); + SetLength(GraphFrm.Ypoints, 1, Nf1cells); + for i := 0 to Nf1cells - 1 do + begin + RowSums[i] := RowSums[i] / RowCount[i]; + GraphFrm.Ypoints[0,i] := RowSums[i]; + if (RowSums[i] > maxmean) then maxmean := RowSums[i]; + XValue[i] := minf1 + i; + GraphFrm.Xpoints[0,i] := XValue[i]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := Nf1cells; + GraphFrm.Heading := Factor1.Text; + GraphFrm.XTitle := Factor1.Text + ' Codes'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + + // Factor B next + GraphFrm.SetLabels[1] := 'FACTOR B'; + maxmean := 0.0; + SetLength(GraphFrm.Xpoints, 1, Nf2cells); + SetLength(GraphFrm.Ypoints, 1, Nf2cells); + for i := 0 to Nf2cells - 1 do + begin + ColSums[i] := ColSums[i] / ColCount[i]; + GraphFrm.Ypoints[0,i] := ColSums[i]; + if (ColSums[i] > maxmean) then maxmean := ColSums[i]; + XValue[i] := minf2 + i; + GraphFrm.Xpoints[0,i] := XValue[i]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := Nf2cells; + GraphFrm.Heading := Factor2.Text; + GraphFrm.XTitle := Factor2.Text + ' Codes'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + + // Factor C next + GraphFrm.SetLabels[1] := 'FACTOR C'; + maxmean := 0.0; + SetLength(GraphFrm.Xpoints, 1, Nf3cells); + SetLength(GraphFrm.Ypoints, 1, Nf3cells); + for i := 0 to Nf3cells - 1 do + begin + SlcSums[i] := SlcSums[i] / SlcCount[i]; + GraphFrm.Ypoints[0,i] := SlcSums[i]; + if (SlcSums[i] > maxmean) then maxmean := SlcSums[i]; + XValue[i] := minf3 + i; + GraphFrm.Xpoints[0,i] := XValue[i]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := Nf3cells; + GraphFrm.Heading := Factor3.Text; + GraphFrm.XTitle := Factor2.Text + ' Codes'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + + // Factor A x B Interaction within each slice next + SetLength(GraphFrm.Ypoints, Nf1cells, Nf2cells); + SetLength(GraphFrm.Xpoints, 1, Nf2cells); + for k := 0 to Nf3cells - 1 do + begin + maxmean := 0.0; + for i := 0 to Nf1cells - 1 do + begin + GraphFrm.SetLabels[i+1] := Factor1.Text + ' ' + IntToStr(i+1); + for j := 0 to Nf2cells - 1 do + begin + XBar := wsum[i,j,k] / ncnt[i,j,k]; + if (XBar > maxmean) then maxmean := XBar; + GraphFrm.Ypoints[i,j] := XBar; + end; + end; + for j := 0 to Nf2cells - 1 do + begin + XValue[j] := minf2 + j ; + GraphFrm.Xpoints[0,j] := XValue[j]; + end; + + GraphFrm.nosets := Nf1cells; + GraphFrm.nbars := Nf2cells; + GraphFrm.Heading := 'Factor A x Factor B Within C ' + IntToStr(k+1); + GraphFrm.XTitle := Factor2.Text + ' Codes'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.2; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + + // Factor A x C Interaction within each Column next + SetLength(GraphFrm.Xpoints, 1, Nf3cells); + SetLength(GraphFrm.Ypoints, Nf1cells, Nf3cells); + for j := 0 to Nf2cells - 1 do + begin + maxmean := 0.0; + for i := 0 to Nf1cells - 1 do + begin + GraphFrm.SetLabels[i+1] := Factor1.Text + ' ' + IntToStr(i+1); + for k := 0 to Nf3cells - 1 do + begin + XBar := wsum[i,j,k] / ncnt[i,j,k]; + if (XBar > maxmean) then maxmean := XBar; + GraphFrm.Ypoints[i,k] := XBar; + end; + end; + for k := 0 to Nf3cells - 1 do + begin + XValue[k] := minf3 + k; + GraphFrm.Xpoints[0,k] := XValue[k]; + end; + + GraphFrm.nosets := Nf1cells; + GraphFrm.nbars := Nf3cells; + GraphFrm.Heading := 'Factor A x Factor C Within B ' + IntToStr(j+1); + GraphFrm.XTitle := Factor3.Text + ' Codes'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.2; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + + // Factor B x C Interaction within each row next + SetLength(GraphFrm.Xpoints, 1, Nf3cells); + SetLength(GraphFrm.Ypoints, Nf2cells, Nf3cells); + for i := 0 to Nf1cells - 1 do + begin + maxmean := 0.0; + for j := 0 to Nf2cells - 1 do + begin + GraphFrm.SetLabels[j+1] := Factor2.Text + ' ' + IntToStr(j+1); + for k := 0 to Nf3cells - 1 do + begin + XBar := wsum[i,j,k] / ncnt[i,j,k]; + if (XBar > maxmean) then maxmean := XBar; + GraphFrm.Ypoints[j,k] := XBar; + end; + end; + for j := 0 to Nf3cells - 1 do + begin + XValue[j] := minf3 + j; + GraphFrm.Xpoints[0,j] := XValue[j]; + end; + + GraphFrm.nosets := Nf2cells; + GraphFrm.nbars := Nf3cells; + GraphFrm.Heading := 'Factor B x Factor C Within A ' + IntToStr(i+1); + GraphFrm.XTitle := Factor3.Text + ' Codes'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.2; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; // next row + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + XValue := nil; +end; + +procedure TOneCaseAnovaForm.TwoWayContrasts(AReport: TStrings); +var + i, j: integer; + value, alpha: double; + variances: DblDyneVec; + RowSS, ColSS: double; +begin + if not comparisons then + exit; + if CompError then + exit; + + SetLength(variances, totcells); + alpha := StrToFloat(PostAlpha.Text); + + // row comparisons + if (Nf1cells > 2) and (ProbF1 < Overall) then + begin + for i := 0 to NoGrpsA - 1 do + begin + RowSS := 0.0; + for j := 0 to NoGrpsB - 1 do RowSS := RowSS + vars[i,j]; + variances[i] := RowSS - sqr(RowSums[i]) / RowCount[i]; + variances[i] := variances[i] / (RowCount[i] - 1.0); + end; + + AReport.Add(''); + AReport.Add('COMPARISONS AMONG ROWS'); + + // get smallest group size + value := 1e308; + for i := 0 to Nf1cells - 1 do + if (RowCount[i] < value) then value := RowCount[i]; + + if ScheffeChk.Checked then + ScheffeTest(MSErr, RowSums, RowCount, minf1, maxf1, N, posthocAlpha, AReport); + if TukeyHSDChk.Checked and equal_grp then + Tukey(MSErr, DFErr, value, RowSums, RowCount, minf1, maxf1, posthocAlpha, AReport); + if TukeyBChk.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, RowSums, RowCount, minf1, maxf1, value, posthocAlpha, AReport); + if TukeyKramerChk.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, RowSums, RowCount, minf1, maxf1, posthocAlpha, AReport); +// if (BonferroniChk.Checked) then +// Bonferroni(RowSums,RowCount,variances,minf1,maxf1, AReport); +// if (OrthogonalChk.Checked) then +// CONTRASTS(MSErr,DFErr,RowSums,RowCount,minf1,maxf1,Alpha, AReport); + if NewmanKeulsChk.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, RowSums, RowCount, minf1, maxf1, posthocAlpha, AReport); + end; + + // column comparisons + if (Nf2cells > 2) and (ProbF2 < Alpha) then + begin + for j := 0 to NoGrpsB - 1 do + begin + ColSS := 0.0; + for i := 0 to NoGrpsA - 1 do ColSS := ColSS + vars[i,j]; + variances[j] := ColSS - (ColSums[j] * ColSums[j] / ColCount[j]); + variances[j] := variances[j] / (ColCount[j] - 1.0); + end; + AReport.Add(''); + AReport.Add('COMPARISONS AMONG COLUMNS'); + value := 1e308; + for i := 0 to Nf2cells - 1 do + if (ColCount[i] < value) then value := ColCount[i]; + + if ScheffeChk.Checked then + ScheffeTest(MSErr, ColSums, ColCount, minf2, maxf2, N, posthocAlpha, AReport); + if TukeyHSDChk.Checked and equal_grp then + Tukey(MSErr, DFErr, value, ColSums, ColCount, minf2, maxf2, posthocAlpha, AReport); + if TukeyBChk.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, ColSums, ColCount, minf2, maxf2, value, posthocAlpha, AReport); + if TukeyKramerChk.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, ColSums, ColCount, minf2, maxf2, posthocAlpha, AReport); +// if (BonferroniChk.Checked) then +// Bonferroni(ColSums,ColCount,variances,minf2,maxf2, AReport); +// if (OrthogonalChk.Checked) then +// CONTRASTS(MSErr,DFErr,ColSums,ColCount,minf2,maxf2,Alpha, AReport); + if NewmanKeulsChk.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, ColSums, ColCount, minf2, maxf2, posthocAlpha, AReport); + end; + + // simple effects for columns within each row + if (ProbF3 < Alpha) then + begin + AReport.Add(''); + AReport.Add('COMPARISONS AMONG COLUMNS WITHIN EACH ROW'); + for i := 0 to Nf1cells - 1 do + begin + AReport.Add(''); + AReport.Add('ROW %d COMPARISONS', [i+1]); + // move cell sums and counts to cellsums and cellcnts + for j := 0 to Nf2cells - 1 do + begin + cellsums[j] := sums[i,j]; + cellcnts[j] := counts[i,j]; + cellvars[j] := vars[i,j]; + end; + value := 1e308; + for j := 0 to Nf2cells - 1 do + if (cellcnts[j] < value) then value := cellcnts[j]; + + if ScheffeChk.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf2, maxf2, N, posthocAlpha, AReport); + if TukeyHSDChk.Checked and equal_grp then + Tukey(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if TukeyBChk.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf2, maxf2, value, posthocAlpha, AReport); + if TukeyKramerChk.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); +// if (BonferroniChk.Checked) then +// Bonferroni(cellsums,cellcnts,cellvars,minf2,maxf2, AReport); +// if (OrthogonalChk.Checked) then +// CONTRASTS(MSErr,DFErr,cellsums,cellcnts,minf2,maxf2,0.05, AReport); + if NewmanKeulsChk.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + end; + end; + + // simple effects for rows within each column + if (ProbF3 < Alpha) then + begin + AReport.Add(''); + AReport.Add('COMPARISONS AMONG ROWS WITHIN EACH COLUMN'); + for j := 0 to Nf2cells - 1 do + begin + AReport.Add(''); + AReport.Add('COLUMN %d COMPARISONS', [j+1]); + // move cell sums and counts to cellsums and cellcnts + for i := 0 to Nf1cells - 1 do + begin + cellsums[i] := sums[i,j]; + cellcnts[i] := counts[i,j]; + cellvars[i] := vars[i,j]; + end; + value := 1e308; + for i := 0 to Nf1cells - 1 do + if (cellcnts[j] < value) then value := cellcnts[j]; + + if ScheffeChk.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf1, maxf1, N, posthocAlpha, AReport); + if TukeyHSDChk.Checked and equal_grp then + Tukey(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + if TukeyBChk.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf1, maxf1, value, posthocAlpha, AReport); + if TukeyKramerChk.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); +// if (BonferroniChk.Checked) then +// Bonferroni(cellsums,cellcnts,cellvars,minf1,maxf1, AReport); +// if (OrthogonalChk.Checked) then +// CONTRASTS(MSErr,DFErr,cellsums,cellcnts,minf1,maxf1,0.05, AReport); + if NewmanKeulsChk.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + end; + end; + variances := nil; +end; + +procedure TOneCaseAnovaForm.ThreeWayContrasts(AReport: TStrings); +var + i, j, k: integer; + value, alpha: double; + variances: DblDyneVec; + RowSS, ColSS, SlcSS: double; +begin + if not comparisons then + exit; + if CompError then + exit; + + alpha := StrToFloat(PostAlpha.Text); + if not (ScheffeChk.Checked or TukeyHSDChk.Checked or TukeyBChk.Checked or + TukeyKramerChk.Checked or NewmanKeulsChk.Checked) then exit; + + SetLength(variances, totcells); + + // row comparisons + if (Nf1cells > 2) and (ProbF1 < Alpha) then + begin + for i := 0 to NoGrpsA - 1 do + begin + RowSS := 0.0; + for j := 0 to NoGrpsB - 1 do + for k := 0 to NoGrpsC - 1 do + RowSS := RowSS + wx2[i,j,k]; + variances[i] := RowSS - sqr(RowSums[i]) / RowCount[i]; + variances[i] := variances[i] / (RowCount[i] - 1.0); + end; + AReport.Add(''); + AReport.Add('COMPARISONS AMONG ROWS'); + + // get smallest group size + value := 1e308; + for i := 0 to Nf1cells - 1 do + if (RowCount[i] < value) then value := RowCount[i]; + + if ScheffeChk.Checked then + ScheffeTest(MSErr, RowSums, RowCount, minf1, maxf1, N, posthocAlpha, AReport); + if TukeyHSDChk.Checked and equal_grp then + Tukey(MSErr, DFErr, value, RowSums, RowCount, minf1, maxf1, posthocAlpha, AReport); + if TukeyBChk.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, RowSums, RowCount, minf1, maxf1, value, posthocAlpha, AReport); + if TukeyKramerChk.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, RowSums, RowCount, minf1, maxf1, posthocAlpha, AReport); +// if (BonferroniChk.Checked) then +// Bonferroni(RowSums,RowCount,variances,minf1,maxf1, AReport); +// if (OrthogonalChk.Checked) then +// CONTRASTS(MSErr,DFErr,RowSums,RowCount,minf1,maxf1,Alpha, AReport); + if NewmanKeulsChk.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, RowSums, RowCount, minf1, maxf1, posthocAlpha, AReport); + end; + + // column comparisons + if (Nf2cells > 2) and (ProbF2 < Alpha) then + begin + for j := 0 to NoGrpsB - 1 do + begin + ColSS := 0.0; + for i := 0 to NoGrpsA - 1 do + for k := 0 to NoGrpsC - 1 do + ColSS := ColSS + wx2[i,j,k]; + variances[j] := ColSS - sqr(ColSums[j]) / ColCount[j]; + variances[j] := variances[j] / (ColCount[j] - 1.0); + end; + AReport.Add(''); + AReport.Add('COMPARISONS AMONG COLUMNS'); + value := 1e308; + for i := 0 to Nf2cells - 1 do + if (ColCount[i] < value) then value := ColCount[i]; + + if ScheffeChk.Checked then + ScheffeTest(MSErr, ColSums, ColCount, minf2, maxf2, N, posthocAlpha, AReport); + if TukeyHSDChk.Checked and equal_grp then + Tukey(MSErr, DFErr, value, ColSums, ColCount, minf2, maxf2, posthocAlpha, AReport); + if TukeyBChk.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, ColSums, ColCount, minf2, maxf2, value, posthocAlpha, AReport); + if TukeyKramerChk.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, ColSums, ColCount, minf2, maxf2, posthocAlpha, AReport); +// if (BonferroniChk.Checked) then +// Bonferroni(ColSums,ColCount,variances,minf2,maxf2, AReport); +// if (OrthogonalChk.Checked) then +// CONTRASTS(MSErr,DFErr,ColSums,ColCount,minf2,maxf2,Alpha, AReport); + if NewmanKeulsChk.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, ColSums, ColCount, minf2, maxf2, posthocAlpha, AReport); + end; + + // slice comparisons + if (Nf3cells > 2) and (ProbF3 < Alpha) then + begin + for k := 0 to NoGrpsC - 1 do + begin + SlcSS := 0.0; + for i := 0 to NoGrpsA - 1 do + for j := 0 to NoGrpsB - 1 do SlcSS := SlcSS + wx2[i,j,k]; + variances[k] := SlcSS - sqr(SlcSums[k]) / SlcCount[k]; + variances[k] := variances[k] / (SlcCount[k] - 1.0); + end; + AReport.Add(''); + AReport.Add('COMPARISONS AMONG SLICES'); + value := 1e308; + for i := 0 to Nf3cells - 1 do + if (SlcCount[i] < value) then value := SlcCount[i]; + + if ScheffeChk.Checked then + ScheffeTest(MSErr, SlcSums, SlcCount, minf3, maxf3, N, posthocAlpha, AReport); + if TukeyHSDChk.Checked and equal_grp then + Tukey(MSErr, DFErr, value, SlcSums, SlcCount, minf3, maxf3, posthocAlpha, AReport); + if TukeyBChk.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, SlcSums, SlcCount, minf3, maxf3, value, posthocAlpha, AReport); + if TukeyKramerChk.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, SlcSums, SlcCount, minf3, maxf3, posthocAlpha, AReport); +// if (BonferroniChk.Checked) then +// Bonferroni(SlcSums,SlcCount,variances,minf3,maxf3, AReport); +// if (OrthogonalChk.Checked) then +// CONTRASTS(MSErr,DFErr,SlcSums,SlcCount,minf3,maxf3,Alpha, AReport); + if NewmanKeulsChk.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, SlcSums, SlcCount, minf3, maxf3, posthocAlpha, AReport); + end; + + // simple effects for columns within each row + if (ProbF1F2 < Alpha) then + begin + AReport.Add(''); + AReport.Add('COMPARISONS AMONG COLUMNS WITHIN EACH ROW'); + for i := 0 to Nf1cells - 1 do + begin + AReport.Add(''); + AReport.Add('ROW %d COMPARISONS', [i+1]); + // move cell sums && counts to cellsums && cellcnts + for j := 0 to Nf2cells - 1 do + begin + for k := 0 to Nf3cells - 1 do + begin + cellsums[j] := wsum[i,j,k]; + cellcnts[j] := ncnt[i,j,k]; + cellvars[j] := wx2[i,j,k]; + end; + end; + value := 1e308; + for j := 0 to Nf2cells - 1 do + if (cellcnts[j] < value) then value := cellcnts[j]; + + if ScheffeChk.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf2, maxf2, N, posthocAlpha, AReport); + if TukeyHSDChk.Checked and equal_grp then + Tukey(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if TukeyBChk.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf2, maxf2, value, posthocAlpha, AReport); + if TukeyKramerChk.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); +// if (BonferroniChk.Checked) then +// Bonferroni(cellsums,cellcnts,cellvars,minf2,maxf2, AReport); +// if (OrthogonalChk.Checked) then +// CONTRASTS(MSErr,DFErr,cellsums,cellcnts,minf2,maxf2,0.05, AReport); + if NewmanKeulsChk.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + end; + end; + + // simple effects for rows within each column + if (ProbF1F2 < Alpha) then + begin + AReport.Add(''); + AReport.Add('COMPARISONS AMONG ROWS WITHIN EACH COLUMN'); + for j := 0 to Nf2cells - 1 do + begin + AReport.Add(''); + AReport.Add('COLUMN %d COMPARISONS', [j+1]); + // move cell sums && counts to cellsums && cellcnts + for i := 0 to Nf1cells - 1 do + begin + for k := 0 to Nf3cells - 1 do + begin + cellsums[i] := wsum[i,j,k]; + cellcnts[i] := ncnt[i,j,k]; + cellvars[i] := wx2[i,j,k]; + end; + end; + value := 1e308; + for i := 0 to Nf1cells - 1 do + if (cellcnts[j] < value) then value := cellcnts[j]; + + if ScheffeChk.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf1, maxf1, N, posthocAlpha, AReport); + if TukeyHSDChk.Checked and equal_grp then + Tukey(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + if TukeyBChk.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf1, maxf1, value, posthocAlpha, AReport); + if TukeyKramerChk.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); +// if (BonferroniChk.Checked) then +// Bonferroni(cellsums,cellcnts,cellvars,minf1,maxf1, AReport); +// if (OrthogonalChk.Checked) then +// CONTRASTS(MSErr,DFErr,cellsums,cellcnts,minf1,maxf1,0.05, AReport); + if NewmanKeulsChk.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + end; + end; + + // simple effects for columns within each slice + if (ProbF2F3 < Alpha) then + begin + AReport.Add(''); + AReport.Add('COMPARISONS AMONG COLUMNS WITHIN EACH SLICE'); + for k := 0 to Nf3cells - 1 do + begin + AReport.Add(''); + AReport.Add('SLICE %d COMPARISONS', [k+1]); + // move cell sums && counts to cellsums && cellcnts + for j := 0 to Nf2cells - 1 do + begin + for i := 0 to Nf1cells - 1 do + begin + cellsums[j] := wsum[i,j,k]; + cellcnts[j] := ncnt[i,j,k]; + cellvars[j] := wx2[i,j,k]; + end; + end; + value := 1e308; + for j := 0 to Nf2cells-1 do + if (cellcnts[j] < value) then value := cellcnts[j]; + + if ScheffeChk.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf2, maxf2, N, posthocAlpha, AReport); + if TukeyHSDChk.Checked and equal_grp then + Tukey(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if TukeyBChk.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf2, maxf2, value, posthocAlpha, AReport); + if TukeyKramerChk.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); +// if (BonferroniChk.Checked) then +// Bonferroni(cellsums, cellcnts, cellvars, minf2, maxf2, posthocAlpha, AReport); +// if (OrthogonalChk.Checked) then +// CONTRASTS(MSErr, DFErr, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + if NewmanKeulsChk.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, cellsums, cellcnts, minf2, maxf2, posthocAlpha, AReport); + end; + end; + + // simple effects for rows within each slice + if (ProbF1F3 < Alpha) then + begin + AReport.Add(''); + AReport.Add('COMPARISONS AMONG ROWS WITHIN EACH SLICE'); + for k := 0 to Nf3cells - 1 do + begin + AReport.Add(''); + AReport.Add('SLICE %d COMPARISONS', [k+1]); + // move cell sums && counts to cellsums && cellcnts + for i := 0 to Nf1cells - 1 do + begin + for j := 0 to Nf2cells - 1 do + begin + cellsums[j] := wsum[i,j,k]; + cellcnts[j] := ncnt[i,j,k]; + cellvars[j] := wx2[i,j,k]; + end; + end; + value := 1e308; + for i := 0 to Nf1cells - 1 do + if (cellcnts[i] < value) then value := cellcnts[i]; + + if ScheffeChk.Checked then + ScheffeTest(MSErr, cellsums, cellcnts, minf1, maxf1, N, posthocAlpha, AReport); + if TukeyHSDChk.Checked and equal_grp then + Tukey(MSErr,DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + if TukeyBChk.Checked and equal_grp then + TukeyBTest(MSErr, DFErr, cellsums, cellcnts, minf1, maxf1, value, posthocAlpha, AReport); + if TukeyKramerChk.Checked and equal_grp then + Tukey_Kramer(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); +// if (BonferroniChk.Checked) then +// Bonferroni(cellsums,cellcnts,cellvars,minf1,maxf1, posthocAlpha, AReport); +// if (OrthogonalChk.Checked) then +// CONTRASTS(MSErr,DFErr,cellsums,cellcnts,minf1,maxf1,posthocAlpha, AReport); + if NewmanKeulsChk.Checked and equal_grp then + Newman_Keuls(MSErr, DFErr, value, cellsums, cellcnts, minf1, maxf1, posthocAlpha, AReport); + end; + end; + + variances := nil; +end; + +procedure TOneCaseAnovaForm.UpdateBtnStates; +var + i: Integer; + lSelected: Boolean; +begin + lSelected := false; + for i:=0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + DepIn.Enabled := lSelected and (DepVar.Text = ''); + Fact1In.Enabled := lSelected and (Factor1.Text = ''); + Fact2In.Enabled := lSelected and (Factor2.Text = ''); + Fact3In.Enabled := lSelected and (Factor3.Text = ''); + DepOut.Enabled := DepVar.Text <> ''; + Fact1Out.Enabled := Factor1.Text <> ''; + Fact2Out.Enabled := Factor2.Text <> ''; + Fact3Out.Enabled := Factor3.Text <> ''; +end; + +procedure TOneCaseAnovaForm.VarListSelectionChange(Sender: TObject; + User: boolean); +begin + UpdateBtnStates; +end; + +function TOneCaseAnovaForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + X: Double; +begin + Result := false; + if (OverallAlpha.Text = '') then + begin + AControl := OverallAlpha; + AMsg := 'No value specified for overall alpha.'; + exit; + end; + if not TryStrToFloat(OverallAlpha.Text, X) then + begin + AControl := OverallAlpha; + AMsg := 'Overall alpha is not a valid number.'; + exit; + end; + + if (PostAlpha.Text = '') then + begin + AControl := PostAlpha; + AMsg := 'No value specified for post-hoc alpha.'; + exit; + end; + if not TryStrToFloat(PostAlpha.Text, x) then + begin + AControl := PostAlpha; + AMsg := 'Post-hoc alpha is not a valid number.'; + exit; + end; + + Result := true; +end; + +initialization + {$I onecaseanovaunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/ttestunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/ttestunit.lfm new file mode 100644 index 000000000..2fbef7200 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/ttestunit.lfm @@ -0,0 +1,686 @@ +object TtestFrm: TTtestFrm + Left = 629 + Height = 505 + Top = 216 + Width = 544 + AutoSize = True + Caption = 'Comparison of Two Sample Means' + ClientHeight = 505 + ClientWidth = 544 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = CloseBtn + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 477 + Width = 149 + BorderSpacing.Left = 8 + Caption = 'Percent Confidence Interval:' + ParentColor = False + end + object RadioGroup1: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 72 + Top = 8 + Width = 195 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Data Entry By:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 191 + Items.Strings = ( + 'Values Entered on this Form' + 'Values in the data grid file' + ) + OnClick = RadioGroup1Click + TabOrder = 0 + end + object RadioGroup2: TRadioGroup + AnchorSideLeft.Control = RadioGroup1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + Left = 219 + Height = 72 + Top = 8 + Width = 152 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + Caption = 'Test Assumptions:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 148 + Items.Strings = ( + 'Independent Scores' + 'Correlated Scores' + ) + OnClick = RadioGroup2Click + TabOrder = 1 + end + object CInterval: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ResetBtn + AnchorSideTop.Side = asrCenter + Left = 165 + Height = 23 + Top = 473 + Width = 46 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 4 + Text = '95.0' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 331 + Height = 25 + Top = 472 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 393 + Height = 25 + Top = 472 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 477 + Height = 25 + Top = 472 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 7 + end + object RadioGroup3: TRadioGroup + AnchorSideLeft.Control = RadioGroup2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + Left = 387 + Height = 72 + Top = 8 + Width = 140 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + Caption = 'Test Probability' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 136 + ItemIndex = 0 + Items.Strings = ( + 'Two-tailed (default)' + 'One-tailed' + ) + TabOrder = 2 + end + object Notebook1: TNotebook + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Bevel3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 360 + Top = 96 + Width = 528 + PageIndex = 1 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 3 + object Page1: TPage + object Panel2: TPanel + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Page1 + Left = 48 + Height = 117 + Top = 16 + Width = 433 + AutoSize = True + BorderSpacing.Top = 16 + BevelOuter = bvNone + ClientHeight = 117 + ClientWidth = 433 + TabOrder = 0 + object Mean1Label: TLabel + AnchorSideTop.Control = Mean1 + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 4 + Width = 39 + BorderSpacing.Left = 8 + Caption = 'Mean 1' + ParentColor = False + end + object Mean2Label: TLabel + AnchorSideTop.Control = Mean2 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Mean1Label + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 15 + Top = 51 + Width = 39 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Mean 2' + ParentColor = False + end + object SD1Label: TLabel + AnchorSideLeft.Control = Mean1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SD1 + AnchorSideTop.Side = asrCenter + Left = 145 + Height = 15 + Top = 4 + Width = 55 + BorderSpacing.Left = 24 + Caption = 'Std. Dev. 1' + ParentColor = False + end + object SD2Label: TLabel + AnchorSideTop.Control = SD2 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = SD2 + Left = 145 + Height = 15 + Top = 51 + Width = 55 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Std. Dev. 2' + ParentColor = False + end + object SampSize1Label: TLabel + AnchorSideLeft.Control = SD1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = N1 + AnchorSideTop.Side = asrCenter + Left = 292 + Height = 15 + Top = 4 + Width = 71 + BorderSpacing.Left = 24 + Caption = 'Sample Size 1' + ParentColor = False + end + object SampSize2Label: TLabel + AnchorSideTop.Control = N2 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = N2 + Left = 292 + Height = 15 + Top = 51 + Width = 71 + Anchors = [akTop] + BorderSpacing.Right = 8 + Caption = 'Sample Size 2' + ParentColor = False + end + object CorBetweenLabel: TLabel + AnchorSideTop.Control = Cor12 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Cor12 + Left = 60 + Height = 15 + Top = 98 + Width = 147 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Correlation Between Scores:' + ParentColor = False + end + object Mean1: TEdit + AnchorSideLeft.Control = Mean1Label + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + Left = 55 + Height = 23 + Top = 0 + Width = 66 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 0 + Text = 'Mean1' + end + object Mean2: TEdit + AnchorSideLeft.Control = Mean1 + AnchorSideTop.Control = Mean1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Mean1 + AnchorSideRight.Side = asrBottom + Left = 55 + Height = 23 + Top = 47 + Width = 66 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 24 + TabOrder = 3 + Text = 'Mean2' + end + object SD1: TEdit + AnchorSideLeft.Control = SD1Label + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + Left = 208 + Height = 23 + Top = 0 + Width = 60 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 1 + Text = 'SD1' + end + object SD2: TEdit + AnchorSideLeft.Control = SD1 + AnchorSideTop.Control = SD1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = SD1 + AnchorSideRight.Side = asrBottom + Left = 208 + Height = 23 + Top = 47 + Width = 60 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 24 + TabOrder = 4 + Text = 'SD2' + end + object N1: TEdit + AnchorSideLeft.Control = SampSize1Label + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + Left = 371 + Height = 23 + Top = 0 + Width = 62 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 2 + Text = 'N1' + end + object N2: TEdit + AnchorSideLeft.Control = N1 + AnchorSideTop.Control = N1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = N1 + AnchorSideRight.Side = asrBottom + Left = 371 + Height = 23 + Top = 47 + Width = 62 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 24 + TabOrder = 5 + Text = 'N2' + end + object Cor12: TEdit + AnchorSideLeft.Control = SD1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = SD2 + AnchorSideTop.Side = asrBottom + Left = 215 + Height = 23 + Top = 94 + Width = 47 + Alignment = taRightJustify + BorderSpacing.Top = 24 + TabOrder = 6 + Text = 'Cor12' + end + end + end + object Page2: TPage + object Memo1: TLabel + AnchorSideLeft.Control = Page2 + AnchorSideTop.Control = Page2 + AnchorSideRight.Control = Page2 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 75 + Top = 0 + Width = 528 + Anchors = [akTop, akLeft, akRight] + Caption = 'Directions: '#13#10'For independent groups data, first click the variable to be analyzed then click the variable containing group codes. '#13#10'For dependent variables it is assumed the data for each pair of values are in a case. '#13#10'Enter the names of those two variables.' + ParentColor = False + WordWrap = True + end + object SelVarLabel: TLabel + AnchorSideLeft.Control = Page2 + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 15 + Top = 91 + Width = 83 + BorderSpacing.Top = 16 + Caption = 'Select Variables:' + ParentColor = False + end + object ListBox1: TListBox + AnchorSideLeft.Control = Page2 + AnchorSideTop.Control = SelVarLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Bevel1 + AnchorSideBottom.Control = Page2 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 252 + Top = 108 + Width = 256 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + ItemHeight = 0 + OnClick = ListBox1Click + TabOrder = 0 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Page2 + AnchorSideLeft.Side = asrCenter + Left = 256 + Height = 91 + Top = 92 + Width = 16 + Shape = bsSpacer + end + object FirstVarLabel: TLabel + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Var1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Var1 + Left = 284 + Height = 15 + Top = 112 + Width = 62 + Alignment = taRightJustify + BorderSpacing.Left = 12 + BorderSpacing.Right = 8 + Caption = '1st Variable:' + ParentColor = False + end + object SecdVarLabel: TLabel + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Var2 + Left = 279 + Height = 15 + Top = 143 + Width = 67 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = '2nd Variable:' + ParentColor = False + end + object GrpLabel: TLabel + AnchorSideTop.Control = Grp + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Grp + Left = 279 + Height = 15 + Top = 143 + Width = 67 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Group Code:' + ParentColor = False + end + object Bevel5: TBevel + Left = 273 + Height = 11 + Top = 92 + Width = 87 + Shape = bsSpacer + end + object Var1: TEdit + AnchorSideLeft.Control = FirstVarLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ListBox1 + AnchorSideRight.Control = Page2 + AnchorSideRight.Side = asrBottom + Left = 354 + Height = 23 + Top = 108 + Width = 174 + Anchors = [akTop, akLeft, akRight] + TabOrder = 1 + Text = 'Var1' + end + object Var2: TEdit + AnchorSideLeft.Control = Var1 + AnchorSideTop.Control = Var1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Var1 + AnchorSideRight.Side = asrBottom + Left = 354 + Height = 23 + Top = 139 + Width = 174 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 2 + Text = 'Var2' + end + object Grp: TEdit + AnchorSideLeft.Control = Var1 + AnchorSideTop.Control = Var1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Var2 + AnchorSideRight.Side = asrBottom + Left = 354 + Height = 23 + Top = 139 + Width = 174 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 3 + Text = 'Grp' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Grp + AnchorSideTop.Control = Grp + AnchorSideTop.Side = asrBottom + Left = 354 + Height = 90 + Top = 170 + Width = 164 + AutoSize = True + BorderSpacing.Top = 8 + ClientHeight = 70 + ClientWidth = 160 + TabOrder = 5 + object Grp1Code: TEdit + AnchorSideTop.Control = GroupBox1 + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 100 + Height = 23 + Top = 8 + Width = 52 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Enabled = False + TabOrder = 0 + Text = 'Grp1Code' + end + object Grp2Code: TEdit + AnchorSideTop.Control = Grp1Code + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 100 + Height = 23 + Top = 39 + Width = 52 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Enabled = False + TabOrder = 1 + Text = 'Grp2Code' + end + object GrpCodeLabel1: TLabel + AnchorSideTop.Control = Grp1Code + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Grp1Code + Left = 16 + Height = 15 + Top = 12 + Width = 76 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Left = 16 + BorderSpacing.Right = 8 + Caption = 'Group 1 Code:' + Enabled = False + ParentColor = False + end + object GrpCodeLabel2: TLabel + AnchorSideTop.Control = Grp2Code + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Grp2Code + Left = 16 + Height = 15 + Top = 43 + Width = 76 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Group 2 Code:' + Enabled = False + ParentColor = False + end + end + object GroupCodeBtn: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + Left = 362 + Height = 19 + Top = 170 + Width = 130 + BorderSpacing.Left = 8 + Caption = 'Specify Group Codes' + OnChange = GroupCodeBtnChange + TabOrder = 4 + end + end + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 456 + Width = 544 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Bevel3: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = RadioGroup1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 80 + Width = 544 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Bottom = 8 + Shape = bsBottomLine + end + object Bevel4: TBevel + Left = 5 + Height = 11 + Top = 382 + Width = 15 + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/ttestunit.pas b/applications/lazstats/source/forms/analysis/comparisons/ttestunit.pas new file mode 100644 index 000000000..2d9324688 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/ttestunit.pas @@ -0,0 +1,624 @@ +unit TTestUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, + MainUnit, Globals, FunctionsLib, OutputUnit, DataProcs; + +type + + { TTtestFrm } + + TTtestFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + Bevel3: TBevel; + Bevel4: TBevel; + Bevel5: TBevel; + GroupBox1: TGroupBox; + GroupCodeBtn: TCheckBox; + Grp1Code: TEdit; + Grp2Code: TEdit; + GrpCodeLabel1: TLabel; + GrpCodeLabel2: TLabel; + Memo1: TLabel; + Notebook1: TNotebook; + Page1: TPage; + Page2: TPage; + RadioGroup3: TRadioGroup; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + CorBetweenLabel: TLabel; + Cor12: TEdit; + CInterval: TEdit; + Grp: TEdit; + Label1: TLabel; + Var2: TEdit; + Var1: TEdit; + FirstVarLabel: TLabel; + GrpLabel: TLabel; + SecdVarLabel: TLabel; + ListBox1: TListBox; + SelVarLabel: TLabel; + N2: TEdit; + N1: TEdit; + SampSize2Label: TLabel; + SampSize1Label: TLabel; + SD2: TEdit; + SD1: TEdit; + SD2Label: TLabel; + SD1Label: TLabel; + Mean2: TEdit; + Mean1: TEdit; + Mean2Label: TLabel; + Mean1Label: TLabel; + Panel2: TPanel; + RadioGroup1: TRadioGroup; + RadioGroup2: TRadioGroup; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure GroupCodeBtnChange(Sender: TObject); + procedure ListBox1Click(Sender: TObject); + procedure RadioGroup1Click(Sender: TObject); + procedure RadioGroup2Click(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + independent: boolean; + griddata: boolean; + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + + public + { public declarations } + end; + +var + TtestFrm: TTtestFrm; + +implementation + +uses + Math; + +{ TTtestFrm } + +procedure TTtestFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + CInterval.Text := FormatFloat('0.0', DEFAULT_CONFIDENCE_LEVEL_PERCENT); + RadioGroup1.ItemIndex := 0; + RadioGroup2.ItemIndex := 0; + Notebook1.PageIndex := RadioGroup1.ItemIndex; + ListBox1.Clear; + Var1.Text := ''; + Var2.Text := ''; + Mean1.Text := ''; + Mean2.Text := ''; + SD1.Text := ''; + SD2.Text := ''; + N1.Text := ''; + N2.Text := ''; + Cor12.Text := ''; + independent := true; + griddata := false; + GroupCodeBtn.Checked := false; + Grp.Text := ''; + for i := 1 to NoVariables do + ListBox1.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + Grp.Text := ''; + Grp1Code.Text := ''; + Grp2Code.Text := ''; +end; + +procedure TTtestFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := CInterval.Left + CInterval.Width + (Width - ResetBtn.Left) + ResetBtn.BorderSpacing.Left; + + Bevel5.Width := SecdVarLabel.Canvas.TextWidth(SecdVarlabel.Caption); + //ListBox1.Constraints.MinHeight := Grp2Code.Top + Grp2Code.Height - Listbox1.Top - Var2.Height - Var2.BorderSpacing.Top; + + //Constraints.MinHeight := ListBox1.Top + ListBox1.Constraints.MinHeight + Bevel2.Height + CloseBtn.Height + CloseBtn.BorderSpacing.Top*2; + FAutoSized := true; +end; + +procedure TTtestFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TTtestFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TTtestFrm.GroupCodeBtnChange(Sender: TObject); +begin + Grp1Code.Enabled := GroupCodeBtn.Checked; + Grp2Code.Enabled := GroupCodeBtn.Checked; + GrpCodeLabel1.Enabled := GroupCodeBtn.Checked; + GrpCodeLabel2.Enabled := GroupCodeBtn.Checked; +end; + +procedure TTtestFrm.ComputeBtnClick(Sender: TObject); +var + M1, M2, Dif, stddev1, stddev2, r12, stderr1, stderr2: double; + tequal, tunequal, cov12, lowci, hici, F, Fp, df1, df2: double; + tprobability, value1, value2: double; + variance1, variance2, pooled, sedif, df, ConfInt, tconfint: double; + i, v1, v2, ncases1, ncases2, NoSelected: integer; + group, min, max: integer; + ColNoSelected: IntDyneVec; + label1Str, label2Str: string; + msg: String; + C: TWinControl; + lReport: TStrings; +begin + if not Validate(msg, C) then + begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + ModalResult := mrNone; + exit; + end; + + SetLength(ColNoSelected,NoVariables); + ncases1 := 0; + ncases2 := 0; + variance1 := 0.0; + variance2 := 0.0; + M1 := 0.0; + M2 := 0.0; + Dif := 0.0; + r12 := 0.0; + v1 := 0; + v2 := 0; + stddev1 := 0.0; + stddev2 := 0.0; + + ConfInt := (100.0 - StrToFloat(CInterval.Text)) / 2.0 ; + ConfInt := (100.0 - ConfInt) / 100.0; // one tail + + if independent then + Var2.Text := Grp.Text; + + // data read from grid + if griddata then + begin + for i := 1 to NoVariables do + begin + if Var1.Text = OS3MainFrm.DataGrid.Cells[i,0] then + begin + v1 := i; + ColNoSelected[0] := i; + label1Str := Var1.Text; + end; + if Var2.Text = OS3MainFrm.DataGrid.Cells[i,0] then + begin + v2 := i; + ColNoSelected[1] := i; + label2Str := Var2.Text; + end; + end; // next variable + + ncases1 := 0; + ncases2 := 0; + NoSelected := 2; + M1 := 0.0; + M2 := 0.0; + variance1 := 0.0; + variance2 := 0.0; + r12 := 0.0; + if not independent then // correlated data + begin + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + ncases1 := ncases1 + 1; + value1 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v1,i])); + value2 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v2,i])); + M1 := M1 + value1; + M2 := M2 + value2; + variance1 := variance1 + value1 * value1; + variance2 := variance2 + value2 * value2; + r12 := r12 + value1 * value2; + end; + + ncases2 := ncases1; + variance1 := variance1 - (M1 * M1 / ncases1); + variance1 := variance1 / (ncases1 - 1); + stddev1 := sqrt(variance1); + variance2 := variance2 - (M2 * M2 / ncases2); + variance2 := variance2 / (ncases2 - 1); + stddev2 := sqrt(variance2); + r12 := r12 - (M1 * M2 / ncases1); + r12 := r12 / (ncases1 - 1); + cov12 := r12; + r12 := r12 / (stddev1 * stddev2); + M1 := M1 / ncases1; + M2 := M2 / ncases2; + Dif := M1 - M2; + end; //if not independent + + if independent then + begin + if GroupCodeBtn.Checked then + begin + min := StrToInt(Grp1Code.Text); + max := StrToInt(Grp2Code.Text); + { + response := InputBox('Group 1','Enter the code for group 1','1'); + min := StrToInt(response); + response := InputBox('Group 2','Enter the code for group 2','2'); + max := StrToInt(response); + } + end else + begin + min := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v2,1]))); + max := min; + end; + + for i := 2 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v2,i]))); + if GroupCodeBtn.Checked = false then + begin + if group < min then min := group; + if group > max then max := group; + end; + end; + + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + value1 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v1,i])); + value2 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v2,i])); + group := round(value2); + if group = min then + begin + M1 := M1 + value1; + variance1 := variance1 + (value1 * value1); + ncases1 := ncases1 + 1; + end else if group = max then + begin + M2 := M2 + value1; + variance2 := variance2 + (value1 * value1); + ncases2 := Ncases2 + 1; + end; + end; // next case + + variance1 := variance1 - ((M1 * M1) / ncases1); + variance1 := variance1 / (ncases1 - 1); + stddev1 := sqrt(variance1); + variance2 := variance2 - ((M2 * M2) / ncases2); + variance2 := variance2 / (ncases2 - 1); + stddev2 := sqrt(variance2); + M1 := M1 / ncases1; + M2 := M2 / ncases2; + Dif := M1 - M2; + Label1Str := format('Group %d',[min]); + Label2Str := format('Group %d',[max]); + end; // if independent data + end; // if reading grid data + + if not griddata then // data read from form + begin + M1 := StrToFloat(Mean1.Text); + M2 := StrToFloat(Mean2.Text); + stddev1 := StrToFloat(SD1.Text); + stddev2 := StrToFloat(SD2.Text); + ncases1 := round(StrToFloat(N1.Text)); + ncases2 := round(StrToFloat(N2.Text)); + variance1 := stddev1 * stddev1; + variance2 := stddev2 * stddev2; + Label1Str := 'Group 1'; + Label2Str := 'Group 2'; + Dif := M1 - M2; + if not independent then + begin + r12 := StrToFloat(Cor12.Text); + cov12 := r12 * stddev1 * stddev2; + end; + end; + + + // Initialize output form + lReport := TStringList.Create; + try + lReport.Add('COMPARISON OF TWO MEANS'); + lReport.Add(''); + + // Calculate pooled and independent t and z values and test statistic + if independent then + begin + stderr1 := sqrt(variance1 / ncases1); + Stderr2 := sqrt(variance2 / ncases2); + lReport.Add('Variable Mean Variance Std.Dev. S.E.Mean N'); + lReport.Add('%-10s%8.2f %8.2f %8.2f %8.2f %d', [Label1Str, M1, variance1, stddev1, stderr1, ncases1]); + lReport.Add('%-10s%8.2f %8.2f %8.2f %8.2f %d', [Label2Str, M2, variance2, stddev2, stderr2, ncases2]); + lReport.Add(''); + + pooled := ((ncases1-1) * variance1) + ((ncases2-1) * variance2); + pooled := pooled / (ncases1 + ncases2 - 2); + pooled := pooled * ( 1.0 / ncases1 + 1.0 / ncases2); + sedif := sqrt(pooled); + tequal := dif / sedif; + df := ncases1 + ncases2 - 2; + tprobability := probt(tequal,df); + if RadioGroup3.ItemIndex = 1 then tprobability := 0.5 * tprobability; + lReport.Add('Assuming equal variances, t = %.3f with probability = %.4f and %.0f degrees of freedom', [ + tequal, tprobability, df + ]); + lReport.Add('Difference = %.2f and Standard Error of difference = %.2f', [dif, sedif]); + + tconfint := inverset(ConfInt,df); + lowci := dif - tconfint * sedif; + hici := dif + tconfint * sedif; + lReport.Add('Confidence interval = (%.2f ... %.2f)', [lowci, hici]); + + // now for unequal variances + sedif := sqrt((variance1 / ncases1) + (variance2 / ncases2)); + tunequal := dif / sedif; + df := sqr((variance1 / ncases1) + (variance2 / ncases2)); + df := df / (sqr(variance1 / ncases1) / (ncases1 - 1) + sqr(variance2 / ncases2) / (ncases2 - 1) ); + tprobability := probt(tequal,df); + if RadioGroup3.ItemIndex = 1 then tprobability := 0.5 * tprobability; + lReport.Add('Assuming unequal variances, t = %.3f with probability = %.4f and %.0f degrees of freedom', [ + tunequal, tprobability, df + ]); + lReport.Add('Difference = %.2f and Standard Error of difference = %.2f', [dif, sedif]); + + tconfint := inverset(ConfInt,df); + lowci := dif - tconfint * sedif; + hici := dif + tconfint * sedif; + lReport.Add('Confidence interval = (%.2f ... %.2f)', [lowci, hici]); + + df1 := ncases1 - 1; + df2 := ncases2 - 1; + if variance1 > variance2 then + begin + F := variance1 / variance2; + Fp := probf(F,df1,df2); + end else + begin + F := variance2 / variance1; + Fp := probf(F,df2,df1); + end; + lReport.Add('F test for equal variances = %.3f, Probability = %.4f', [F, fp]); + end + else + // dependent t test + begin + stderr1 := sqrt(variance1 / ncases1); + Stderr2 := sqrt(variance2 / ncases2); + lReport.Add('Variable Mean Variance Std.Dev. S.E.Mean N'); + lReport.Add('%-10s%8.2f %8.2f %8.2f %8.2f %d', [Label1Str, M1, variance1, stddev1, stderr1, ncases1]); + lReport.Add('%-10s%8.2f %8.2f %8.2f %8.2f %d', [Label2Str,M2, variance2, stddev2, stderr2, ncases2]); + lReport.Add(''); + sedif := variance1 + variance2 - (2.0 * cov12); + sedif := sqrt(sedif / ncases1); + tequal := Dif / sedif; + df := ncases1 - 1; + tprobability := probt(tequal,df); + lReport.Add('Assuming dependent samples, t = %.3f with probability = %.4f and %.0f degrees of freedom', [ + tequal, tprobability, df + ]); + lReport.Add('Correlation between %s and %s = %.3f', [Label1Str, Label2Str, r12]); + lReport.Add('Difference = %.2f and Standard Error of difference = %.2f', [dif, sedif]); + + tconfint := inverset(ConfInt,df); + lowci := dif - tconfint * sedif; + hici := dif + tconfint * sedif; + lReport.Add('Confidence interval = (%.2f ... %.2f)', [lowci, hici]); + + tequal := variance1 - variance2; + tequal := tequal / sqrt( (4 * variance1 * variance2)/(ncases1 - 2) * (1.0 - sqr(r12)) ); + df := ncases1 - 2; + tprobability := probt(tequal,df); + lReport.Add('t for test of equal variances = %.3f with probability = %.4f', [tequal, tprobability]); + end; + + DisplayReport(lReport); + + finally + lReport.Free; + ColNoSelected := nil; + end; +end; + +procedure TTtestFrm.ListBox1Click(Sender: TObject); +VAR index : integer; +begin + index := ListBox1.ItemIndex; + if not independent then + begin + if Var1.Text <> '' then Var2.Text := ListBox1.Items.Strings[index] + else Var1.Text := ListBox1.Items.Strings[index]; + end; + if independent then + begin + if Var1.Text <> '' then Grp.Text := ListBox1.Items.Strings[index] + else Var1.Text := ListBox1.Items.Strings[index]; + end; +end; + +procedure TTtestFrm.RadioGroup1Click(Sender: TObject); +VAR + index : integer; +begin + index := RadioGroup1.ItemIndex; + Notebook1.PageIndex := index; + if index = 0 then + begin +// Panel2.Visible := true; +// Panel1.Visible := false; + griddata := false; + end + else + begin +// Panel1.Visible := true; +// Panel2.Visible := false; + griddata := true; + if RadioGroup2.ItemIndex = 1 then + begin + SecdVarLabel.Visible := true; + Var2.Visible := true; + Grp.Visible := false; + GrpLabel.Visible := false; + end + else + begin + SecdVarLabel.Visible := false; + Var2.Visible := false; + Grp.Visible := true; + GrpLabel.Visible := true; + end; + end; +end; + +procedure TTtestFrm.RadioGroup2Click(Sender: TObject); +var + index: integer; +begin + index := RadioGroup2.ItemIndex; + independent := (index = 0); + Grp.Visible := independent; + GrpLabel.Visible := independent; + GroupCodeBtn.Visible := independent; + GroupBox1.Visible := independent; + SecdVarLabel.Visible := not independent; + Var2.Visible := not independent; + { + if index = 0 then + begin + independent := true; + CorBetweenLabel.Visible := false; + Cor12.Visible := false; + Grp.Visible := true; + GrpLabel.Visible := true; + GroupCodeBtn.Visible := true; + Groupbxo1.Visible := true; + SecdVarLabel.Visible := false; + Var2.Visible := false; + end + else + begin + independent := false; + CorBetweenLabel.Visible := true; + Cor12.Visible := true; + GrpLabel.Visible := false; + Grp.Visible := false; + GroupCodeBtn.Visible := false; + SecdVarLabel.Visible := true; + Var2.Visible := true; + end; + } +end; + +function TTtestFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + n: Integer; + x: Double; +begin + Result := false; + AControl := nil; + AMsg := ''; + if Notebook1.PageIndex = 0 then + begin + if (Mean1.Text = '') or not TryStrToFloat(Mean1.Text, x) then + begin + AControl := Mean1; + AMsg := 'Invalid input for the mean of sample 1'; + exit; + end; + if (SD1.Text = '') or not TryStrToFloat(SD1.Text, x) or (x <= 0) then + begin + AControl := SD1; + AMsg := 'Invald input for the standard deviation of sample 1'; + exit; + end; + if (N1.Text = '') or not TryStrToInt(N1.Text, n) or (n <= 0) then + begin + AControl := N1; + AMsg := 'Invald input for the size of sample 1'; + exit; + end; + if (Mean2.Text = '') or not TryStrToFloat(Mean2.Text, x) then + begin + AControl := Mean2; + AMsg := 'Invalid input for the mean of sample 2'; + exit; + end; + if (SD2.Text = '') or not TryStrToFloat(SD2.Text, x) or (x <= 0) then + begin + AControl := SD2; + AMsg := 'Invald input for the standard deviation of sample 2'; + exit; + end; + if (N2.Text = '') or not TryStrToInt(N2.Text, n) or (n <= 0) then + begin + AControl := N2; + AMsg := 'Invald input for the size of sample 2'; + exit; + end; + end else + if Notebook1.PageIndex = 1 then + begin + if (Var1.Text = '') then + begin + AControl := Var1; + AMsg := 'Variable 1 not specified.'; + exit; + end; + if Var2.Visible and (Var2.Text = '') then + begin + AControl := Var2; + AMsg := 'Variable 2 not specified.'; + exit; + end; + if Grp.Visible and (Grp.Text = '') then + begin + AControl := Grp; + AMsg := 'Group variable not specified.'; + exit; + end; + if Grp1Code.Visible and ((Grp1Code.Text = '') or not TryStrToInt(Grp1Code.Text, n))then + begin + AControl := Grp1Code; + AMsg := 'Code for group 1 missing.'; + exit; + end; + if Grp2Code.Visible and ((Grp2Code.Text = '') or not TryStrToInt(Grp2Code.Text, n))then + begin + AControl := Grp2Code; + AMsg := 'Code for group 2 missing.'; + exit; + end; + end; + Result := true; +end; + +initialization + {$I ttestunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/twocorrsunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/twocorrsunit.lfm new file mode 100644 index 000000000..376077cc3 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/twocorrsunit.lfm @@ -0,0 +1,634 @@ +object TwoCorrsFrm: TTwoCorrsFrm + Left = 559 + Height = 391 + Top = 286 + Width = 462 + Caption = 'Comparison of Two Correlations' + ClientHeight = 391 + ClientWidth = 462 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label14: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = CInterval + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 323 + Width = 149 + BorderSpacing.Left = 8 + Caption = 'Percent Confidence Interval:' + ParentColor = False + end + object RadioGroup1: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 72 + Top = 8 + Width = 225 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Data Entered From:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 221 + Items.Strings = ( + 'Values entered on this form.' + 'Values in the data grid from a file.' + ) + OnClick = RadioGroup1Click + TabOrder = 0 + end + object RadioGroup2: TRadioGroup + AnchorSideLeft.Control = RadioGroup1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + Left = 257 + Height = 72 + Top = 8 + Width = 185 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 24 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Test Assumptions:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 181 + Items.Strings = ( + 'Independent Correlations.' + 'Dependent Correlations.' + ) + OnClick = RadioGroup2Click + TabOrder = 1 + end + object CInterval: TEdit + AnchorSideLeft.Control = Label14 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = Bevel2 + Left = 165 + Height = 23 + Top = 319 + Width = 36 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 3 + Text = 'CInterval' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 243 + Height = 25 + Top = 358 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 305 + Height = 25 + Top = 358 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 389 + Height = 25 + Top = 358 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 7 + end + object HelpBtn: TButton + Tag = 151 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 184 + Height = 25 + Top = 358 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 4 + end + object Notebook1: TNotebook + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = RadioGroup1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CInterval + Left = 8 + Height = 223 + Top = 88 + Width = 454 + PageIndex = 0 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + TabOrder = 2 + object Page1: TPage + object PanelPage1: TPanel + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Page1 + Left = 143 + Height = 132 + Top = 0 + Width = 168 + AutoSize = True + BorderSpacing.Bottom = 24 + BevelOuter = bvNone + ClientHeight = 132 + ClientWidth = 168 + TabOrder = 0 + object firstcorlabel: TLabel + AnchorSideLeft.Control = PanelPage1 + AnchorSideTop.Control = rxy1 + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 20 + Width = 87 + Caption = 'First Correlation:' + ParentColor = False + end + object size1label: TLabel + AnchorSideLeft.Control = PanelPage1 + AnchorSideTop.Control = Size1 + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 51 + Width = 74 + Caption = 'Sample Size 1:' + ParentColor = False + end + object SecdCorLabel: TLabel + AnchorSideLeft.Control = PanelPage1 + AnchorSideTop.Control = rxy2 + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 82 + Width = 104 + Caption = 'Second Correlation:' + ParentColor = False + end + object Size2Label: TLabel + AnchorSideLeft.Control = PanelPage1 + AnchorSideTop.Control = Size2 + Left = 0 + Height = 15 + Top = 109 + Width = 74 + Caption = 'Sample Size 2:' + ParentColor = False + end + object rxy1: TEdit + AnchorSideLeft.Control = SecdCorLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = PanelPage1 + Left = 112 + Height = 23 + Top = 16 + Width = 56 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + TabOrder = 0 + Text = 'rxy1' + end + object Size1: TEdit + AnchorSideLeft.Control = SecdCorLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = rxy1 + AnchorSideTop.Side = asrBottom + Left = 112 + Height = 23 + Top = 47 + Width = 56 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 1 + Text = 'Edit1' + end + object rxy2: TEdit + AnchorSideLeft.Control = SecdCorLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Size1 + AnchorSideTop.Side = asrBottom + Left = 112 + Height = 23 + Top = 78 + Width = 56 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 2 + Text = 'Edit1' + end + object Size2: TEdit + AnchorSideLeft.Control = SecdCorLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = rxy2 + AnchorSideTop.Side = asrBottom + Left = 112 + Height = 23 + Top = 109 + Width = 56 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 3 + Text = 'Edit1' + end + end + end + object Page2: TPage + object PanelPage2: TPanel + AnchorSideLeft.Control = Page2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Page2 + Left = 144 + Height = 156 + Top = 0 + Width = 167 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 156 + ClientWidth = 167 + TabOrder = 0 + object corxylabel: TLabel + AnchorSideLeft.Control = PanelPage2 + AnchorSideTop.Control = rxy + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 20 + Width = 89 + Caption = 'Correlation r(x,y)' + ParentColor = False + end + object corxzlabel: TLabel + AnchorSideLeft.Control = PanelPage2 + AnchorSideTop.Control = rxz + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 51 + Width = 88 + Caption = 'Correlation r(x,z)' + ParentColor = False + end + object coryzlabel: TLabel + AnchorSideLeft.Control = PanelPage2 + AnchorSideTop.Control = ryz + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 82 + Width = 88 + Caption = 'Correlation r(y,z)' + ParentColor = False + end + object sampsizelabel: TLabel + AnchorSideLeft.Control = PanelPage2 + AnchorSideTop.Control = SampSize + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 113 + Width = 65 + Caption = 'Sample Size:' + ParentColor = False + end + object rxy: TEdit + AnchorSideLeft.Control = corxylabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = PanelPage2 + Left = 105 + Height = 23 + Top = 16 + Width = 62 + Alignment = taRightJustify + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + TabOrder = 0 + Text = 'rxy' + end + object SampSize: TEdit + AnchorSideLeft.Control = rxy + AnchorSideTop.Control = ryz + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = rxy + AnchorSideRight.Side = asrBottom + Left = 105 + Height = 23 + Top = 109 + Width = 62 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 24 + TabOrder = 3 + Text = 'Edit1' + end + object rxz: TEdit + AnchorSideLeft.Control = rxy + AnchorSideTop.Control = rxy + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = rxy + AnchorSideRight.Side = asrBottom + Left = 105 + Height = 23 + Top = 47 + Width = 62 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 1 + Text = 'Edit1' + end + object ryz: TEdit + AnchorSideLeft.Control = rxy + AnchorSideTop.Control = rxz + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = rxy + AnchorSideRight.Side = asrBottom + Left = 105 + Height = 23 + Top = 78 + Width = 62 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 2 + Text = 'Edit1' + end + end + end + object Page3: TPage + object PanelPage3: TPanel + Left = 0 + Height = 223 + Top = 0 + Width = 446 + Align = alClient + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 223 + ClientWidth = 446 + TabOrder = 0 + object SelVarLabel: TLabel + AnchorSideLeft.Control = PanelPage3 + AnchorSideTop.Control = PanelPage3 + Left = 0 + Height = 15 + Top = 0 + Width = 83 + Caption = 'Select Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = PanelPage3 + AnchorSideTop.Control = SelVarLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideBottom.Control = PanelPage3 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 206 + Top = 17 + Width = 246 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + ItemHeight = 0 + OnClick = VarListClick + TabOrder = 0 + end + object Bevel1: TBevel + AnchorSideLeft.Control = PanelPage3 + AnchorSideLeft.Side = asrCenter + Left = 200 + Height = 13 + Top = 2 + Width = 46 + Shape = bsSpacer + end + object Panel1: TPanel + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = PanelPage3 + AnchorSideRight.Side = asrBottom + Left = 246 + Height = 116 + Top = 32 + Width = 162 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 116 + ClientWidth = 162 + TabOrder = 1 + object xlabel: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Xvar + AnchorSideTop.Side = asrCenter + Left = 48 + Height = 15 + Top = 4 + Width = 18 + Alignment = taRightJustify + BorderSpacing.Left = 48 + Caption = 'X =' + ParentColor = False + end + object Xvar: TEdit + AnchorSideLeft.Control = xlabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + Left = 74 + Height = 23 + Top = 0 + Width = 88 + BorderSpacing.Left = 8 + ReadOnly = True + TabOrder = 0 + Text = 'Xvar' + end + object ylabel: TLabel + AnchorSideTop.Control = Yvar + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = xlabel + AnchorSideRight.Side = asrBottom + Left = 48 + Height = 15 + Top = 35 + Width = 18 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Y =' + ParentColor = False + end + object Yvar: TEdit + AnchorSideLeft.Control = Xvar + AnchorSideTop.Control = Xvar + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Xvar + AnchorSideRight.Side = asrBottom + Left = 74 + Height = 23 + Top = 31 + Width = 88 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + ReadOnly = True + TabOrder = 1 + Text = 'Edit1' + end + object zlabel: TLabel + AnchorSideTop.Control = Zvar + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = xlabel + AnchorSideRight.Side = asrBottom + Left = 48 + Height = 15 + Top = 66 + Width = 18 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Z =' + ParentColor = False + end + object Zvar: TEdit + AnchorSideLeft.Control = Xvar + AnchorSideTop.Control = Yvar + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Xvar + AnchorSideRight.Side = asrBottom + Left = 74 + Height = 23 + Top = 62 + Width = 88 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + ReadOnly = True + TabOrder = 2 + Text = 'Edit1' + end + object GroupLabel: TLabel + AnchorSideTop.Control = GroupVar + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = xlabel + AnchorSideRight.Side = asrBottom + Left = 22 + Height = 15 + Top = 97 + Width = 44 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Group =' + ParentColor = False + end + object GroupVar: TEdit + AnchorSideLeft.Control = Xvar + AnchorSideTop.Control = Zvar + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Xvar + AnchorSideRight.Side = asrBottom + Left = 74 + Height = 23 + Top = 93 + Width = 88 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + ReadOnly = True + TabOrder = 3 + Text = 'Edit1' + end + end + end + end + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 342 + Width = 462 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/twocorrsunit.pas b/applications/lazstats/source/forms/analysis/comparisons/twocorrsunit.pas new file mode 100644 index 000000000..be2e4461c --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/twocorrsunit.pas @@ -0,0 +1,679 @@ +unit TwoCorrsUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, + MainUnit, Globals, FunctionsLib, OutputUnit, DataProcs, ContextHelpUnit; + +type + + { TTwoCorrsFrm } + + TTwoCorrsFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + HelpBtn: TButton; + Notebook1: TNotebook; + Page1: TPage; + Page2: TPage; + Page3: TPage; + Panel1: TPanel; + PanelPage1: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + CInterval: TEdit; + Label14: TLabel; + Xvar: TEdit; + Yvar: TEdit; + Zvar: TEdit; + GroupVar: TEdit; + xlabel: TLabel; + ylabel: TLabel; + zlabel: TLabel; + GroupLabel: TLabel; + SelVarLabel: TLabel; + VarList: TListBox; + PanelPage3: TPanel; + rxy1: TEdit; + Size1: TEdit; + rxy2: TEdit; + Size2: TEdit; + firstcorlabel: TLabel; + size1label: TLabel; + SecdCorLabel: TLabel; + Size2Label: TLabel; + rxy: TEdit; + rxz: TEdit; + ryz: TEdit; + SampSize: TEdit; + corxylabel: TLabel; + corxzlabel: TLabel; + coryzlabel: TLabel; + sampsizelabel: TLabel; + PanelPage2: TPanel; + RadioGroup1: TRadioGroup; + RadioGroup2: TRadioGroup; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure RadioGroup1Click(Sender: TObject); + procedure RadioGroup2Click(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + independent: boolean; + griddata: boolean; + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + + public + { public declarations } + end; + +var + TwoCorrsFrm: TTwoCorrsFrm; + +implementation + +uses + Math; + +{ TTwoCorrsFrm } + +procedure TTwoCorrsFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + CInterval.Text := FormatFloat('0.0', DEFAULT_CONFIDENCE_LEVEL_PERCENT); + + RadioGroup1.ItemIndex := 0; + RadioGroup2.ItemIndex := 0; + Notebook1.PageIndex := 0; + VarList.Clear; + Xvar.Text := ''; + Yvar.Text := ''; + Zvar.Text := ''; + rxy.Text := ''; + rxz.Text := ''; + ryz.Text := ''; + SampSize.Text := ''; + rxy1.Text := ''; + rxy2.Text := ''; + Size1.Text := ''; + Size2.Text := ''; + zlabel.Visible := false; + Zvar.Visible := false; + GroupLabel.Visible := true; + GroupVar.Text := ''; + GroupVar.Visible := true; + independent := true; + griddata := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TTwoCorrsFrm.VarListClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if Xvar.Text = '' then + begin + Xvar.Text := VarList.Items.Strings[index]; + exit; + end; + + if Yvar.Text = '' then + begin + Yvar.Text := VarList.Items.Strings[index]; + exit; + end; + + if not independent then + begin + if Zvar.Text = '' then + begin + Zvar.Text := VarList.Items.Strings[index]; + exit; + end; + end; + + if independent then + begin + if GroupVar.Text = '' then + begin + GroupVar.Text := VarList.Items.Strings[index]; + exit; + end; + end; +end; + +procedure TTwoCorrsFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Width := Max( + RadioGroup2.Left + RadioGroup2.Width + RadioGroup2.BorderSpacing.Right, + Width - HelpBtn.Left + HelpBtn.BorderSpacing.Left + ); + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TTwoCorrsFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TTwoCorrsFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TTwoCorrsFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TTwoCorrsFrm.ComputeBtnClick(Sender: TObject); +var + Corxy, Corxz, Coryz, Cor1, Cor2, alpha, tvalue, df1, df2: double; + CorDif, zOne, zTwo, zDif, StdErr, zValue, zprobability: double; + UCL, LCL, ztest, ConfLevel, tprobability, ttest: double; + mean1, mean2, mean3, variance1, variance2, variance3: double; + stddev1, stddev2, stddev3, value1, value2, value3: double; + meanx1, meanx2, meany1, meany2, varx1, varx2, vary1, vary2: double; + sdx1, sdx2, sdy1, sdy2: double; + SSize1, SSize2, SSize, v1, v2, v3, grp, ncases, NoSelected: integer; + min, max, grpval, ncases1, ncases2, i: integer; + cellstring: string; + ColNoSelected: IntDyneVec; + msg: String; + C: TWinControl; + lReport: TStrings; +begin + if not Validate(msg, C) then + begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + ModalResult := mrNone; + exit; + end; + + SetLength(ColNoSelected,NoVariables); + Corxy := 0.0; + Corxz := 0.0; + Coryz := 0.0; + Cor1 := 0.0; + Cor2 := 0.0; + mean1 := 0.0; + mean2 := 0.0; + mean3 := 0.0; + variance1 := 0.0; + variance2 := 0.0; + variance3 := 0.0; + meanx1 := 0.0; + meanx2 := 0.0; + meany1 := 0.0; + ConfLevel := StrToFloat(CInterval.Text) / 100.0; + + // *** USE DATA ON THE FORM *** + if not griddata then + begin + // read data from form and obtain results + if independent then + begin + Cor1 := StrToFloat(rxy1.Text); + Cor2 := StrToFloat(rxy2.Text); + SSize1 := StrToInt(Size1.Text); + SSize2 := StrToInt(Size2.Text); + CorDif := Cor1 - Cor2; + zOne := 0.5 * ln((1.0 + Cor1) / (1.0 - Cor1)); + zTwo := 0.5 * ln((1.0 + Cor2) / (1.0 - Cor2)); + zDif := zOne - zTwo; + StdErr := sqrt((1.0 / (SSize1 - 3.0)) + (1.0 / (SSize2 -3.0))); + zValue := zDif / StdErr; + alpha := (1.0 - ConfLevel) / 2.0; + zTest := inversez(1.0 - alpha); + zprobability := 1.0 - probz(zValue); + UCL := zDif + StdErr * zTest; + LCL := zDif - StdErr * zTest; + UCL := (exp(2.0 * UCL) - 1.0) / (exp(2.0 * UCL) + 1.0); + LCL := (exp(2.0 * LCL) - 1.0) / (exp(2.0 * LCL) + 1.0); + end; + + // obtain data from form and obtain results + if not independent then + begin + Corxy := StrToFloat(rxy.Text); + Corxz := StrToFloat(rxz.Text); + Coryz := StrToFloat(ryz.Text); + SSize := StrToInt(SampSize.Text); + CorDif := Corxy - Corxz; + alpha := (1.0 - ConfLevel) / 2.0; + tvalue := CorDif * sqrt((SSize - 3.0) * (1.0 + Coryz)) / sqrt(2.0 * (1.0 - Corxy*Corxy - Corxz*Corxz - Coryz*Coryz + 2.0*Corxy*Corxz*Coryz)); + df1 := 1.0; + df2 := SSize - 3.0; + tprobability := probt(tvalue,df2); + ttest := inverset(1.0 - alpha, df2); + end; + end; + + if griddata then + begin + v1 := 1; + v2 := 1; + grp := 1; + + // read grid data for independent r's + if independent then + begin + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = Xvar.Text then v1 := i; + if cellstring = Yvar.Text then v2 := i; + if cellstring = GroupVar.Text then grp := i; + end; + ColNoSelected[0] := v1; + ColNoSelected[1] := v2; + ColNoSelected[2] := grp; + NoSelected := 3; + meanx1 := 0.0; + meany1 := 0.0; + varx1 := 0.0; + vary1 := 0.0; + meanx2 := 0.0; + meany2 := 0.0; + varx2 := 0.0; + vary2 := 0.0; + Cor1 := 0.0; + Cor2 := 0.0; + ncases1 := 0; + ncases2 := 0; + min := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[grp,1]))); + max := min; + for i := 2 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + grpval := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[grp,i]))); + if grpval > max then max := grpval; + if grpval < min then min := grpval; + end; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + grpval := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[grp,i]))); + if grpval = min then + begin + ncases1 := ncases1 + 1; + value1 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v1,i])); + meanx1 := meanx1 + value1; + varx1 := varx1 + (value1 * value1); + value2 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v2,i])); + meany1 := meany1 + value2; + vary1 := vary1 + value2 * value2; + Cor1 := Cor1 + value1 * value2; + end; + if grpval = max then + begin + ncases2 := ncases2 + 1; + value1 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v1,i])); + meanx2 := meanx2 + value1; + varx2 := varx2 + (value1 * value1); + value2 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v2,i])); + meany2 := meany2 + value2; + vary2 := vary2 + value2 * value2; + Cor2 := Cor2 + value1 * value2; + end; + end; // next case + varx1 := varx1 - meanx1 * meanx1 / ncases1; + varx1 := varx1 / (ncases1 - 1.0); + varx2 := varx2 - meanx2 * meanx2 / ncases2; + varx2 := varx2 / (ncases2 - 1.0); + vary1 := vary1 - meany1 * meany1 / ncases1; + vary1 := vary1 / (ncases1 - 1.0); + vary2 := vary2 - meany2 * meany2 / ncases2; + vary2 := vary2 / (ncases2 - 1.0); + Cor1 := Cor1 - meanx1 * meany1 / ncases1; + Cor1 := Cor1 / (ncases1 - 1.0); + Cor2 := Cor2 - meanx2 * meany2 / ncases2; + Cor2 := Cor2 / (ncases2 - 1.0); + sdx1 := sqrt(varx1); + sdx2 := sqrt(varx2); + sdy1 := sqrt(vary1); + sdy2 := sqrt(vary2); + Cor1 := Cor1 / (sdx1 * sdy1); + Cor2 := Cor2 / (sdx2 * sdy2); + meanx1 := meanx1 / ncases1; + meany1 := meany1 / ncases1; + meanx2 := meanx2 / ncases2; + meany2 := meany2 / ncases2; + SSize1 := ncases1; + SSize2 := ncases2; + CorDif := Cor1 - Cor2; + zOne := 0.5 * ln((1.0 + Cor1) / (1.0 - Cor1)); + zTwo := 0.5 * ln((1.0 + Cor2) / (1.0 - Cor2)); + zDif := zOne - zTwo; + StdErr := sqrt((1.0 / (SSize1 - 3.0)) + (1.0 / (SSize2 -3.0))); + zValue := zDif / StdErr; + alpha := (1.0 - ConfLevel) / 2.0; + zTest := inversez(1.0 - alpha); + zprobability := 1.0 - probz(zValue); + UCL := zDif + StdErr * zTest; + LCL := zDif - StdErr * zTest; + UCL := (exp(2.0 * UCL) - 1.0) / (exp(2.0 * UCL) + 1.0); + LCL := (exp(2.0 * LCL) - 1.0) / (exp(2.0 * LCL) + 1.0); + end; + + // read grid data for dependent r's + if not independent then + begin + mean1 := 0.0; + mean2 := 0.0; + mean3 := 0.0; + variance1 := 0.0; + variance2 := 0.0; + variance3 := 0.0; + Corxy := 0.0; + Corxz := 0.0; + Coryz := 0.0; + ncases := 0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = Xvar.Text then v1 := i; + if cellstring = Yvar.Text then v2 := i; + if cellstring = ZVar.Text then v3 := i; + end; + ColNoSelected[0] := v1; + ColNoSelected[1] := v2; + ColNoSelected[2] := v3; + NoSelected := 3; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + ncases := ncases + 1; + value1 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v1,i])); + value2 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v2,i])); + value3 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v3,i])); + mean1 := mean1 + value1; + mean2 := mean2 + value2; + mean3 := mean3 + value3; + variance1 := variance1 + value1 * value1; + variance2 := variance2 + value2 * value2; + variance3 := variance3 + value3 * value3; + Corxy := Corxy + value1 * value2; + Corxz := Corxz + value1 * value3; + Coryz := Coryz + value2 * value3; + end; + variance1 := variance1 - mean1 * mean1 / ncases; + variance1 := variance1 / (ncases - 1.0); + stddev1 := sqrt(variance1); + variance2 := variance2 - mean2 * mean2 / ncases; + variance2 := variance2 / (ncases - 1.0); + stddev2 := sqrt(variance2); + variance3 := variance3 - mean3 * mean3 / ncases; + variance3 := variance3 / (ncases - 1.0); + stddev3 := sqrt(variance3); + Corxy := Corxy - mean1 * mean2 / ncases; + Corxy := Corxy / (ncases - 1.0); + Corxy := Corxy / (stddev1 * stddev2); + Corxz := Corxz - mean1 * mean3 / ncases; + Corxz := Corxz / (ncases - 1.0); + Corxz := Corxz / (stddev1 * stddev3); + Coryz := Coryz - mean2 * mean3 / ncases; + Coryz := Coryz / (ncases - 1.0); + Coryz := Coryz / (stddev2 * stddev3); + mean1 := mean1 / ncases; + mean2 := mean2 / ncases; + mean3 := mean3 / ncases; + SSize := ncases; + CorDif := Corxy - Corxz; + alpha := (1.0 - ConfLevel) / 2.0; + tvalue := CorDif * sqrt((SSize - 3.0) * (1.0 + Coryz)) / + sqrt(2.0 * (1.0 - Corxy * Corxy - Corxz * Corxz - Coryz * Coryz + 2.0 * Corxy * Corxz * Coryz)); + df1 := 1.0; + df2 := SSize - 3.0; + tprobability := probt(tvalue,df2); + ttest := inverset(1.0 - alpha, df2); + end; + end; + + // Initialize output form + lReport := TStringList.Create; + try + lReport.Add('COMPARISON OF TWO CORRELATIONS'); + lReport.Add(''); + if independent then + begin + lReport.Add('Correlation one: %6.3f', [Cor1]); + lReport.Add('Sample size one: %6d', [SSize1]); + lReport.Add('Correlation two: %6.3f', [Cor2]); + lReport.Add('Sample size two: %6d', [SSize2]); + lReport.Add('Difference between correlations: %6.3f', [CorDif]); + lReport.Add('Confidence level selected: %6s', [CInterval.Text]); + lReport.Add('z for Correlation One: %6.3f', [zOne]); + lReport.Add('z for Correlation Two: %6.3f', [zTwo]); + lReport.Add('z difference: %6.3f', [zDif]); + lReport.Add('Standard error of difference: %6.3f', [StdErr]); + lReport.Add('z test statistic: %6.3f', [zValue]); + lReport.Add('Probability > |z|: %6.3f', [zprobability]); + lReport.Add('z Required for significance: %6.3f', [zTest]); + lReport.Add('Note: above is a two-tailed test.'); + lReport.Add('Confidence Limits = (%.3f ... %.3f)', [LCL, UCL]); + lReport.Add(''); + if griddata then + begin + lReport.Add('Mean X for group 1: %9.3f', [meanx1]); + lReport.Add('Mean X for group 2: %9.3f', [meanx2]); + lReport.Add('Std.Dev. X for group 1: %9.3f', [sdx1]); + lReport.Add('Std.Dev. X for group 2: %9.3f', [sdx2]); + lReport.Add('Mean y for group 1; %9.3f', [meany1]); + lReport.Add('Mean Y for group 2: %9.3f', [meany2]); + lReport.Add('Std.Dev. Y for group 1: %9.3f', [sdy1]); + lReport.Add('Std.Dev. Y for group 2: %9.3f', [sdy2]); + end; + end; + + if not independent then + begin + lReport.Add('Correlation x with y: %6.3f', [Corxy]); + lReport.Add('Correlation x with z: %6.3f', [Corxz]); + lReport.Add('Correlation y with z: %6.3f', [Coryz]); + lReport.Add('Sample size: %6d', [SSize]); + lReport.Add('Confidence Level Selected: %6s', [CInterval.Text]); + lReport.Add('Difference r(x,y) - r(x,z): %6.3f', [CorDif]); + lReport.Add('t test statistic: %6.3f', [tvalue]); + lReport.Add('Probability > |t|: %6.3f', [tprobability]); + lReport.Add('t value for significance: %6.3f', [ttest]); + lReport.Add(''); + if griddata then + begin + lReport.Add('Variable Mean Variance Std.Dev.'); + lReport.Add(' X %9.3f %9.3f %9.3f', [mean1, variance1, stddev1]); + lReport.Add(' Y %9.3f %9.3f %9.3f', [mean2, variance2, stddev2]); + lReport.Add(' Z %9.3f %9.3f %9.3f', [mean3, variance3, stddev3]); + end; + end; + + DisplayReport(lReport); + + finally + lReport.Free; + ColNoSelected := nil; + end; +end; + +procedure TTwoCorrsFrm.RadioGroup1Click(Sender: TObject); +var + index: integer; +begin + index := RadioGroup1.ItemIndex; + if index = 0 then + begin + griddata := false; + if independent then + Notebook1.PageIndex := 0 + else + Notebook1.PageIndex := 1; + end else + begin + griddata := true; + Notebook1.PageIndex := 2; + end; +end; + +procedure TTwoCorrsFrm.RadioGroup2Click(Sender: TObject); +var + index1, index2: integer; +begin + index1 := RadioGroup1.ItemIndex; + index2 := RadioGroup2.ItemIndex; + + // form input with independent corrs + if ((index2 = 0) and (index1 = 0)) then + begin + independent := true; + Notebook1.PageIndex := 0; + end; + + // grid data for independent corrs + if ((index2 = 0) and (index1 = 1)) then + begin + Notebook1.PageIndex := 2; + zlabel.Visible := false; + zvar.Visible := false; + grouplabel.Visible := true; + groupvar.Visible := true; + end; + + // form data for dependent corrs + if ((index2 = 1) and (index1 = 0)) then + begin + Notebook1.PageIndex := 1; + end; + + // grid data for dependent corrs + if ((index2 = 1) and (index1 = 1)) then + begin + Notebook1.PageIndex := 2; + independent := false; + zlabel.Visible := true; + Zvar.Visible := true; + GroupLabel.Visible := false; + GroupVar.Visible := false; + end; +end; + +function TTwoCorrsFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + n: Integer; + x: Double; +begin + Result := false; + AControl := nil; + AMsg := ''; + if Notebook1.PageIndex = 0 then + begin + if (rxy1.Text = '') or not TryStrToFloat(rxy1.Text, x) then + begin + AControl := rxy1; + AMsg := 'Invalid input for first correlation'; + exit; + end; + if (Size1.Text = '') or not TryStrToInt(Size1.Text, n) or (n <= 0) then + begin + AControl := Size1; + AMsg := 'Invald input for size of sample 1'; + exit; + end; + if (rxy2.Text = '') or not TryStrToFloat(rxy2.Text, x) then + begin + AControl := rxy2; + AMsg := 'Invalid input for second correlation'; + exit; + end; + if (Size2.Text = '') or not TryStrToInt(Size2.Text, n) or (n <= 0) then + begin + AControl := Size2; + AMsg := 'Invalud input for size of sample 2'; + exit; + end; + end else + if Notebook1.PageIndex = 1 then + begin + if (rxy.Text = '') or not TryStrToFloat(rxy.Text, x) then + AControl := rxy + else + if (rxz.Text = '') or not TryStrToFloat(rxz.Text, x) then + AControl := rxz + else + if (ryz.Text = '') or not TryStrToFloat(ryz.Text, x) then + AControl := ryz + else + if (SampSize.Text = '') or not TryStrToInt(SampSize.Text, n) or (n < 0) then + AControl := SampSize; + if AControl <> nil then + begin + AMsg := 'Invalid input.'; + exit; + end; + end else + if Notebook1.PageIndex = 2 then + begin + if XVar.Text = '' then + begin + AControl := XVar; + AMsg := 'X variable not specified.'; + exit; + end; + if YVar.Text = '' then + begin + AControl := YVar; + AMsg := 'Y variable not specified.'; + exit; + end; + case RadioGroup2.ItemIndex of + 0: if (GroupVar.Text = '') then + begin + AControl := GroupVar; + AMsg := 'Group variable not specified'; + exit; + end; + 1: if (ZVar.Text = '') then begin + AControl := ZVar; + AMsg := 'Z variable not specified.'; + exit; + end; + end; + end; + Result := true; +end; + +initialization + {$I twocorrsunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/twopropunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/twopropunit.lfm new file mode 100644 index 000000000..124773693 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/twopropunit.lfm @@ -0,0 +1,585 @@ +object TwoPropFrm: TTwoPropFrm + Left = 603 + Height = 427 + Top = 225 + Width = 455 + Caption = 'Test of Equality for two Proportions' + ClientHeight = 427 + ClientWidth = 455 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + LCLVersion = '2.1.0.0' + object ConfLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = CInterval + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = CInterval + Left = 8 + Height = 15 + Top = 359 + Width = 149 + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Percent Confidence Interval:' + ParentColor = False + end + object CInterval: TEdit + AnchorSideLeft.Control = ConfLabel + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel4 + Left = 165 + Height = 23 + Top = 355 + Width = 41 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + BorderSpacing.Right = 8 + TabOrder = 1 + Text = '95.0' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 242 + Height = 25 + Top = 394 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 304 + Height = 25 + Top = 394 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 388 + Height = 25 + Top = 394 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 5 + end + object HelpBtn: TButton + Tag = 152 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 183 + Height = 25 + Top = 394 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 2 + end + object Notebook1: TNotebook + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CInterval + Left = 8 + Height = 259 + Top = 88 + Width = 439 + PageIndex = 1 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + TabOrder = 0 + object Page1: TPage + AnchorSideTop.Side = asrBottom + object Label11: TLabel + AnchorSideLeft.Control = Page1 + AnchorSideTop.Control = Page1 + Left = 0 + Height = 15 + Top = 0 + Width = 83 + Caption = 'Select Variables:' + ParentColor = False + end + object FirstVarLabel: TLabel + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + Left = 223 + Height = 15 + Top = 17 + Width = 66 + Caption = 'First Variable' + ParentColor = False + end + object SecdVarLabel: TLabel + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Var2 + Left = 223 + Height = 15 + Top = 110 + Width = 83 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Second Variable' + ParentColor = False + end + object GrpLabel: TLabel + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Grp + Left = 223 + Height = 15 + Top = 219 + Width = 64 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Group Code' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Page1 + AnchorSideTop.Control = Label11 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Bevel1 + AnchorSideBottom.Control = Page1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 242 + Top = 17 + Width = 215 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + Constraints.MinHeight = 220 + ItemHeight = 0 + OnClick = VarListClick + TabOrder = 0 + end + object Var1: TEdit + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = FirstVarLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Page1 + AnchorSideRight.Side = asrBottom + Left = 223 + Height = 23 + Top = 34 + Width = 216 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + ReadOnly = True + TabOrder = 1 + Text = 'Var1' + end + object Var2: TEdit + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Page1 + AnchorSideRight.Side = asrBottom + Left = 223 + Height = 23 + Top = 127 + Width = 216 + Anchors = [akTop, akLeft, akRight] + ReadOnly = True + TabOrder = 2 + Text = 'Var2' + end + object Grp: TEdit + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Page1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 223 + Height = 23 + Top = 236 + Width = 216 + Anchors = [akLeft, akRight, akBottom] + ReadOnly = True + TabOrder = 3 + Text = 'Grp' + end + object Bevel1: TBevel + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + Left = 215 + Height = 49 + Top = 53 + Width = 8 + Shape = bsSpacer + end + end + object Page2: TPage + object Panel4: TPanel + AnchorSideTop.Control = Page2 + Left = 24 + Height = 62 + Top = 16 + Width = 344 + AutoSize = True + BorderSpacing.Top = 16 + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 8 + ChildSizing.VerticalSpacing = 12 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 5 + ClientHeight = 62 + ClientWidth = 344 + TabOrder = 0 + object Samp1Label: TLabel + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 23 + Top = 4 + Width = 77 + Caption = 'Sample 1 Freq.' + ParentColor = False + end + object IndFreq1: TEdit + Left = 85 + Height = 23 + Top = 4 + Width = 80 + Alignment = taRightJustify + TabOrder = 0 + Text = 'IndFreq1' + end + object Bevel2: TBevel + Left = 173 + Height = 10 + Top = 4 + Width = 10 + Constraints.MaxHeight = 10 + Constraints.MaxWidth = 10 + Shape = bsSpacer + end + object Samp1SizeLabel: TLabel + AnchorSideTop.Side = asrCenter + Left = 191 + Height = 23 + Top = 4 + Width = 65 + BorderSpacing.Top = 4 + Caption = 'Sample Size:' + ParentColor = False + end + object IndSize1: TEdit + Left = 264 + Height = 23 + Top = 4 + Width = 80 + Alignment = taRightJustify + TabOrder = 1 + Text = 'IndSize1' + end + object Samp2Label: TLabel + Left = 0 + Height = 23 + Top = 39 + Width = 77 + Caption = 'Sample 2 Freq.' + ParentColor = False + end + object IndFreq2: TEdit + Left = 85 + Height = 23 + Top = 39 + Width = 80 + Alignment = taRightJustify + TabOrder = 2 + Text = 'IndFreq2' + end + object Bevel3: TBevel + Left = 173 + Height = 10 + Top = 39 + Width = 10 + Constraints.MaxHeight = 10 + Constraints.MaxWidth = 10 + Shape = bsSpacer + end + object Samp2SizeLabel: TLabel + Left = 191 + Height = 23 + Top = 39 + Width = 65 + Caption = 'Sample Size:' + ParentColor = False + end + object IndSize2: TEdit + Left = 264 + Height = 23 + Top = 39 + Width = 80 + Alignment = taRightJustify + TabOrder = 3 + Text = 'IndSize2' + end + end + end + object Page3: TPage + object DepSamp2Label: TLabel + AnchorSideLeft.Control = Page3 + Left = 8 + Height = 15 + Top = 72 + Width = 45 + BorderSpacing.Left = 8 + Caption = 'Sample2' + ParentColor = False + end + object DepSamp1Label: TLabel + AnchorSideTop.Control = Page3 + Left = 168 + Height = 15 + Top = 0 + Width = 45 + Caption = 'Sample1' + ParentColor = False + end + object Panel3: TPanel + AnchorSideTop.Control = DepSamp1Label + AnchorSideTop.Side = asrBottom + Left = 72 + Height = 85 + Top = 23 + Width = 201 + BorderSpacing.Top = 8 + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 16 + ChildSizing.VerticalSpacing = 12 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 3 + ClientHeight = 85 + ClientWidth = 201 + TabOrder = 0 + object LabelCorner: TLabel + Left = 0 + Height = 15 + Top = 0 + Width = 9 + Caption = ' ' + ParentColor = False + end + object Samp10Label: TLabel + Left = 25 + Height = 15 + Top = 0 + Width = 80 + Alignment = taCenter + Caption = '0' + ParentColor = False + end + object Samp11Label: TLabel + Left = 121 + Height = 15 + Top = 0 + Width = 80 + Alignment = taCenter + Caption = '1' + ParentColor = False + end + object Samp20Label: TLabel + Left = 0 + Height = 23 + Top = 27 + Width = 9 + Caption = '0' + Layout = tlCenter + ParentColor = False + end + object DepFreq00: TEdit + Left = 25 + Height = 23 + Top = 27 + Width = 80 + Alignment = taRightJustify + TabOrder = 0 + Text = 'DepFreq00' + end + object DepFreq10: TEdit + Left = 121 + Height = 23 + Top = 27 + Width = 80 + Alignment = taRightJustify + TabOrder = 1 + Text = 'DepFreq10' + end + object Samp21Label: TLabel + Left = 0 + Height = 23 + Top = 62 + Width = 9 + Caption = '1' + Layout = tlCenter + ParentColor = False + end + object DepFreq01: TEdit + Left = 25 + Height = 23 + Top = 62 + Width = 80 + Alignment = taRightJustify + TabOrder = 2 + Text = 'DepFreq01' + end + object DepFreq11: TEdit + Left = 121 + Height = 23 + Top = 62 + Width = 80 + Alignment = taRightJustify + TabOrder = 3 + Text = 'DepFreq11' + end + end + end + end + object Bevel4: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 378 + Width = 455 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 80 + Top = 0 + Width = 455 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BevelOuter = bvNone + ClientHeight = 80 + ClientWidth = 455 + TabOrder = 6 + object RadioGroup1: TRadioGroup + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Bevel5 + Left = 16 + Height = 72 + Top = 8 + Width = 203 + Anchors = [akTop, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Top = 8 + Caption = 'Data Entry By:' + ChildSizing.LeftRightSpacing = 16 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 199 + Items.Strings = ( + 'Values Entered on this Form' + 'Values in the Data Grid' + ) + OnClick = RadioGroup1Click + TabOrder = 0 + end + object RadioGroup2: TRadioGroup + AnchorSideLeft.Control = Bevel5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + Left = 235 + Height = 72 + Top = 8 + Width = 188 + AutoFill = True + AutoSize = True + BorderSpacing.Top = 8 + Caption = 'Test Assumptions:' + ChildSizing.LeftRightSpacing = 16 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 184 + Items.Strings = ( + 'Independent Proportions' + 'Dependent Proportions' + ) + OnClick = RadioGroup2Click + TabOrder = 1 + end + object Bevel5: TBevel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel1 + Left = 219 + Height = 41 + Top = 0 + Width = 16 + Shape = bsSpacer + end + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/twopropunit.pas b/applications/lazstats/source/forms/analysis/comparisons/twopropunit.pas new file mode 100644 index 000000000..a0430f5c7 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/twopropunit.pas @@ -0,0 +1,541 @@ +unit TwoPropUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, + Graphics, Dialogs, ExtCtrls, StdCtrls, ComCtrls, MainUnit, Globals, + FunctionsLib, OutPutUnit, DataProcs, contexthelpunit; + +type + + { TTwoPropFrm } + + TTwoPropFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + Bevel3: TBevel; + Bevel4: TBevel; + Bevel5: TBevel; + HelpBtn: TButton; + LabelCorner: TLabel; + Notebook1: TNotebook; + Page1: TPage; + Page2: TPage; + Page3: TPage; + Panel1: TPanel; + Panel3: TPanel; + Panel4: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + DepFreq00: TEdit; + DepFreq10: TEdit; + DepFreq01: TEdit; + DepFreq11: TEdit; + CInterval: TEdit; + Grp: TEdit; + GrpLabel: TLabel; + ConfLabel: TLabel; + Var2: TEdit; + SecdVarLabel: TLabel; + Var1: TEdit; + IndSize2: TEdit; + IndSize1: TEdit; + IndFreq2: TEdit; + IndFreq1: TEdit; + Samp1Label: TLabel; + Samp21Label: TLabel; + Label11: TLabel; + FirstVarLabel: TLabel; + Samp2Label: TLabel; + Samp1SizeLabel: TLabel; + Samp2SizeLabel: TLabel; + DepSamp2Label: TLabel; + DepSamp1Label: TLabel; + Samp10Label: TLabel; + Samp11Label: TLabel; + Samp20Label: TLabel; + VarList: TListBox; + RadioGroup1: TRadioGroup; + RadioGroup2: TRadioGroup; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure RadioGroup1Click(Sender: TObject); + procedure RadioGroup2Click(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + independent: boolean; + griddata: boolean; + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + + public + { public declarations } + end; + +var + TwoPropFrm: TTwoPropFrm; + +implementation + +uses + Math; + +{ TTwoPropFrm } + +procedure TTwoPropFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + CInterval.Text := FormatFloat('0.0', DEFAULT_CONFIDENCE_LEVEL_PERCENT); + + RadioGroup1.ItemIndex := 0; + RadioGroup2.ItemIndex := 0; + VarList.Clear; + Var1.Text := ''; + Var2.Text := ''; + independent := true; + griddata := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + GrpLabel.Visible := true; + Grp.Visible := true; + Grp.Text := ''; + Var2.Visible := false; + SecdVarLabel.Visible := false; + DepFreq00.Text := ''; + DepFreq01.Text := ''; + DepFreq10.Text := ''; + DepFreq11.Text := ''; + IndFreq1.Text := ''; + IndFreq2.Text := ''; + IndSize1.Text := ''; + IndSize2.Text := ''; + + Notebook1.PageIndex := 1; +end; + +procedure TTwoPropFrm.VarListClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if not independent then + begin + if Var1.Text <> '' then + Var2.Text := VarList.Items[index] + else + Var1.Text := VarList.Items[index]; + end; + + if independent then + begin + if Var1.Text <> '' then + Grp.Text := VarList.Items[index] + else + Var1.Text := VarList.Items[index]; + end; +end; + +procedure TTwoPropFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TTwoPropFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TTwoPropFrm.ComputeBtnClick(Sender: TObject); +var + ConfInt, Prop1, Prop2, zstatistic, zprobability: double; + PropDif, stderr, UCL, LCL, value1, value2, ztest: double; + P, Q: double; + i, v1, v2, NoSelected, f1, f2, f3, f4, ncases1, ncases2: integer; + min, max, group, AB, AC, CD, BD: integer; + ColNoSelected: IntDyneVec; + msg: String; + C: TWinControl; + lReport: TStrings; +begin + if not Validate(msg, C) then + begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + ModalResult := mrNone; + exit; + end; + + // Initialize output form + stderr := 0.0; + PropDif := 0.0; + v2 := 0; + ztest := 0.0; + Prop1 := 0.0; + Prop2 := 0.0; + NoSelected := 0; + v1 := 0; + zstatistic := 0.0; + zprobability := 0.0; + UCL := 0.0; + LCL := 0.0; + + SetLength(ColNoSelected,NoVariables); + + ConfInt := (100.0 - StrToFloat(CInterval.Text)) / 2.0 ; + ConfInt := (100.0 - ConfInt) / 100.0; // one tail + ncases1 := 0; + ncases2 := 0; + f1 := 0; + f2 := 0; + f3 := 0; + f4 := 0; + if independent then + Var2.Text := Grp.Text; + + if griddata then // data read from grid + begin + for i := 1 to NoVariables do + begin + if Var1.Text = OS3MainFrm.DataGrid.Cells[i,0] then + begin + v1 := i; + ColNoSelected[0] := i; + end; + + if Var2.Text = OS3MainFrm.DataGrid.Cells[i,0] then + begin + v2 := i; + ColNoSelected[1] := i; + end; + end; // next variable + + if not independent then // correlated data + begin + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + ncases1 := ncases1 + 1; + value1 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v1,i])); + value2 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v2,i])); + f1 := f1 + round(value1); + f2 := f2 + round(value2); + end; // next case + f3 := ncases1 - f1; + f4 := ncases1 - f2; + AB := f1 + f2; + AC := f1 + f3; + CD := f3 + f4; + BD := f2 + f4; + Prop1 := BD / ncases1; + Prop2 := AB / ncases1; + stderr := sqrt((f1 / ncases1 + f4 / ncases1) / ncases1); + PropDif := Prop1 - Prop2; + zstatistic := PropDif / stderr; + ztest := inversez(ConfInt); + zprobability := 1.0 - probz(abs(zstatistic)); + UCL := PropDif + stderr * ztest; + LCL := PropDif - stderr * ztest; + end; // if not independent + + if independent then + begin + min := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v2,1]))); + max := min; + for i := 2 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v2,i]))); + if group < min then min := group; + if group > max then max := group; + end; + + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + value1 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v1,i])); + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v2,i]))); + if group = min then + begin + f1 := f1 + round(value1); + ncases1 := ncases1 + 1; + end else + begin + f2 := f2 + round(value1); + ncases2 := ncases2 + 1; + end; + end; // next case + + Prop1 := f1 / ncases1; + Prop2 := f2 / ncases2; + PropDif := Prop1 - Prop2; + P := (f1 + f2) / (ncases1 + ncases2); + Q := 1.0 - P; + stderr := sqrt(P * Q * ((1.0 / ncases1) + (1.0 / ncases2))); + zstatistic := (Prop1 - Prop2) / stderr; + zprobability := 1.0 - probz(abs(zstatistic)); + ztest := inversez(ConfInt); + UCL := PropDif + ztest * stderr; + LCL := PropDif - ztest * stderr; + end; // end if independent + end; // if reading grid data + + if not griddata then // data read from form + begin + if not independent then // correlated data + begin + f1 := round(StrToFloat(DepFreq00.Text)); + f2 := round(StrToFloat(DepFreq10.Text)); + f3 := round(StrToFloat(DepFreq01.Text)); + f4 := round(StrToFloat(DepFreq11.Text)); + ncases1 := f1 + f2 + f3 + f4; + AB := f1 + f2; + AC := f1 + f3; + CD := f3 + f4; + BD := f2 + f4; + Prop1 := BD / ncases1; + Prop2 := AB / ncases1; + stderr := sqrt((f1 / ncases1 + f4 / ncases1) / ncases1); + PropDif := Prop1 - Prop2; + zstatistic := PropDif / stderr; + ztest := inversez(ConfInt); + zprobability := 1.0 - probz(abs(zstatistic)); + UCL := PropDif + stderr * ztest; + LCL := PropDif - stderr * ztest; + end; // if not independent + + if independent then // independent data + begin + f1 := StrToInt(IndFreq1.Text); + f2 := StrToInt(IndFreq2.Text); + ncases1 := StrToInt(IndSize1.Text); + ncases2 := StrToInt(IndSize2.Text); + Prop1 := f1 / ncases1; + Prop2 := f2 / ncases2; + PropDif := Prop1 - Prop2; + P := (f1 + f2) / (ncases1 + ncases2); + Q := 1.0 - P; + stderr := sqrt(P * Q * ((1.0 / ncases1) + (1.0 / ncases2))); + zstatistic := (Prop1 - Prop2) / stderr; + zprobability := 1.0 - probz(abs(zstatistic)); + ztest := inversez(ConfInt); + UCL := PropDif + ztest * stderr; + LCL := PropDif - ztest * stderr; + end; + end; + + // Print the results + lReport := TStringList.Create; + try + lReport.Add('COMPARISON OF TWO PROPORTIONS'); + lReport.Add(''); + if not independent then + begin + lReport.Add('Test for Difference Between Two Dependent Proportions'); + lReport.Add(''); + lReport.Add('Entered Values'); + lReport.Add(''); + lReport.Add('Sample 1'); + lReport.Add(' 0 1 sum'); + lReport.Add(' -----------------------'); + lReport.Add(' 0 |%5d %5d %5d |', [f1, f2, AB]); + lReport.Add(' 2 --------|-------|------'); + lReport.Add(' 1 |%5d %5d %5d |', [f3, f4, CD]); + lReport.Add(' --------|-------|------'); + lReport.Add(' sum | %5d %5d %5d |', [AC, BD, ncases1]); + lReport.Add(''); + lReport.Add('Confidence Level selected: %s', [CInterval.Text]); + lReport.Add('Proportion 1 = %.3f and Proportion 2 = %.3f with %d cases', [Prop1, Prop2, ncases1]); + lReport.Add('Difference in proportions: %9.3f', [PropDif]); + lReport.Add('Standard Error of Difference: %9.3f', [stderr]); + lReport.Add('z test statistic: %9.3f with probability = %.4f', [zstatistic, zprobability]); + lReport.Add('z value for confidence interval: %9.3f', [ztest]); + lReport.Add('Confidence Interval: (%.3f, %.3f)', [LCL, UCL]); + end; + + if independent then + begin + lReport.Add('Test for Difference Between Two Independent Proportions'); + lReport.Add(''); + lReport.Add('Entered Values'); + lReport.Add(''); + lReport.Add('Sample 1: Frequency = %5d for %5d cases.', [f1, ncases1]); + lReport.Add('Sample 2: Frequency = %5d for %5d cases.', [f2, ncases2]); + lReport.Add(''); + lReport.Add('Proportion 1: %9.3f', [Prop1]); + lReport.Add('Proportion 2: %9.3f', [Prop2]); + lReport.Add('Difference: %9.3f', [PropDif]); + lReport.Add('Standard Error of Difference: %9.3f', [stderr]); + lReport.Add('Confidence Level selected: %9s', [CInterval.Text]); + lReport.Add('z test statistic: %9.3f with probability = %.4f', [zstatistic, zprobability]); + lReport.Add('z value for confidence interval: %9.3f', [ztest]); + lReport.Add('Confidence Interval: (%.3f, %.3f)', [LCL, UCL]); + end; + + DisplayReport(lReport); + + finally + lReport.Free; + ColNoSelected := nil; + end; +end; + +procedure TTwoPropFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + RadioGroup2.Constraints.MinWidth := RadioGroup1.Width; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Width := Max( + RadioGroup2.Left + RadioGroup2.Width + RadioGroup2.BorderSpacing.Right, + Width - HelpBtn.Left + HelpBtn.BorderSpacing.Left + ); + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TTwoPropFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TTwoPropFrm.RadioGroup1Click(Sender: TObject); +begin + griddata := RadioGroup1.ItemIndex = 1; + RadioGroup2Click(nil); +end; + +procedure TTwoPropFrm.RadioGroup2Click(Sender: TObject); +begin + case RadioGroup2.ItemIndex of + 0: begin + independent := true; + if griddata then begin + Notebook1.PageIndex := 0; + Var2.Visible := false; + Grp.Visible := true; + SecdVarLabel.Visible := Var2.Visible; + GrpLabel.Visible := Grp.Visible; + end else + Notebook1.PageIndex := 1; + end; + 1: begin + independent := false; + if griddata then begin + Notebook1.PageIndex := 0; + Var2.Visible := true; + Grp.Visible := false; + SecdVarLabel.Visible := Var2.Visible; + GrpLabel.Visible := Grp.Visible; + end else + Notebook1.PageIndex := 2; + end; + end; +end; + +function TTwoPropFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + n: Integer; +begin + Result := false; + AControl := nil; + AMsg := ''; + if Notebook1.PageIndex = 0 then + begin + if Var1.Text = '' then + begin + AControl := Var1; + AMsg := 'First variable not specified.'; + exit; + end; + case RadioGroup2.ItemIndex of + 0: if (Grp.Text = '') then + begin + AControl := Grp; + AMsg := 'Group code not specified'; + exit; + end; + 1: if (Var2.Text = '') then begin + AControl := Var2; + AMsg := 'Second variable not specified.'; + exit; + end; + end; + end else + if Notebook1.PageIndex = 1 then + begin + if (IndFreq1.Text = '') or not TryStrToInt(IndFreq1.Text, n) or (n < 0) then + begin + AControl := IndFreq1; + AMsg := 'Invalid input for Sample 1 frequency'; + exit; + end; + if (IndFreq2.Text = '') or not TryStrToInt(IndFreq2.Text, n) or (n < 0) then + begin + AControl := IndFreq2; + AMsg := 'Invalid input for Sample 2 frequency'; + exit; + end; + if (IndSize1.Text = '') or not TryStrToInt(IndSize1.Text, n) or (n <= 0) then + begin + AControl := IndSize1; + AMsg := 'Invald input for size of sample 1'; + exit; + end; + if (IndSize2.Text = '') or not TryStrToInt(IndSize2.Text, n) or (n <= 0) then + begin + AControl := IndSize2; + AMsg := 'Invalud input for size of sample 2'; + exit; + end; + end else + if Notebook1.PageIndex = 2 then + begin + if (DepFreq00.Text = '') or not TryStrToInt(DepFreq00.Text, n) or (n < 0) then + AControl := DepFreq00 + else + if (DepFreq01.Text = '') or not TryStrToInt(DepFreq01.Text, n) or (n < 0) then + AControl := DepFreq01 + else + if (DepFreq10.Text = '') or not TryStrToInt(DepFreq10.Text, n) or (n < 0) then + AControl := DepFreq10 + else + if (DepFreq11.Text = '') or not TryStrToInt(DepFreq11.Text, n) or (n < 0) then + AControl := DepFreq11; + if AControl <> nil then + begin + AMsg := 'Invalid input.'; + exit; + end; + end; + Result := true; +end; + + +initialization + {$I twopropunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/comparisons/withinanovaunit.lfm b/applications/lazstats/source/forms/analysis/comparisons/withinanovaunit.lfm new file mode 100644 index 000000000..e7bdada22 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/withinanovaunit.lfm @@ -0,0 +1,242 @@ +object WithinANOVAFrm: TWithinANOVAFrm + Left = 544 + Height = 362 + Top = 330 + Width = 458 + AutoSize = True + Caption = 'Within Subjects ANOVA and Hoyt Reliability Estimates' + ClientHeight = 362 + ClientWidth = 458 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = SelList + AnchorSideTop.Control = Owner + Left = 251 + Height = 15 + Top = 8 + Width = 96 + BorderSpacing.Top = 8 + Caption = 'Selected Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 229 + Top = 25 + Width = 199 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 215 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 215 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object SelList: TListBox + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 251 + Height = 229 + Top = 25 + Width = 199 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 3 + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 51 + Top = 262 + Width = 384 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Options:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 20 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 3 + ClientHeight = 31 + ClientWidth = 380 + TabOrder = 4 + object RelChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 124 + Caption = 'Reliability Estimates' + TabOrder = 0 + end + object AssumpChk: TCheckBox + Left = 156 + Height = 19 + Top = 6 + Width = 113 + Caption = 'Test Assumptions' + TabOrder = 1 + end + object PlotChk: TCheckBox + Left = 289 + Height = 19 + Top = 6 + Width = 79 + Caption = 'Plot Means' + TabOrder = 2 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 245 + Height = 25 + Top = 329 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 6 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 307 + Height = 25 + Top = 329 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 7 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 391 + Height = 25 + Top = 329 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 8 + end + object HelpBtn: TButton + Tag = 157 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 186 + Height = 25 + Top = 329 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 5 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 313 + Width = 458 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/comparisons/withinanovaunit.pas b/applications/lazstats/source/forms/analysis/comparisons/withinanovaunit.pas new file mode 100644 index 000000000..17ad1f7c6 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/comparisons/withinanovaunit.pas @@ -0,0 +1,521 @@ +// Use file "itemdata2.laz" for testing + +unit WithinANOVAUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, Math, + MainUnit, FunctionsLib, OutputUnit, MatrixLib, Globals, DataProcs, + GraphLib, ContextHelpUnit; + +type + + { TWithinANOVAFrm } + + TWithinANOVAFrm = class(TForm) + AssumpChk: TCheckBox; + Bevel1: TBevel; + HelpBtn: TButton; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + PlotChk: TCheckBox; + RelChk: TCheckBox; + GroupBox1: TGroupBox; + InBtn: TBitBtn; + Label2: TLabel; + SelList: TListBox; + OutBtn: TBitBtn; + Label1: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + WithinANOVAFrm: TWithinANOVAFrm; + +implementation + +{ TWithinANOVAFrm } + +procedure TWithinANOVAFrm.ResetBtnClick(Sender: TObject); +VAR + i: integer; +begin + VarList.Clear; + SelList.Clear; + PlotChk.Checked := false; + RelChk.Checked := false; + AssumpChk.Checked := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TWithinANOVAFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := True; +end; + +procedure TWithinANOVAFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TWithinANOVAFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TWithinANOVAFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TWithinANOVAFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, f3: integer; + LabelStr: string; + NoSelected, count, row: integer; + SSrows, SScols, SSwrows, SSerr, SStot: double; + MSrows, MScols, MSwrows, MSerr, MStot: double; + dfrows, dfcols, dfwrows, dferr, dftot: double; + f1, f2, probf1, GrandMean, Term1, Term2, Term3, Term4: double; + r1, r2, r3, r4, X, avgvar, avgcov: double; + determ1, determ2, M2, C2, chi2, prob: double; + errorfound: boolean; + Selected: IntDyneVec; + ColLabels: StrDyneVec; + ColMeans, ColVar, RowMeans, RowVar, ColStdDev: DblDyneVec; + varcovmat, vcmat, workmat: DblDyneMat; + title: string; + lReport: TStrings; +begin + if SelList.Items.Count = 0 then + begin + MessageDlg('No variables selected.', mtError, [mbOK], 0); + exit; + end; + if SelList.Items.Count = 1 then + begin + MessageDlg('At least two variables must be selected.', mtError, [mbOK], 0); + exit; + end; + + errorfound := false; + NoSelected := SelList.Items.Count; + Caption := IntToStr(NoSelected); + + SetLength(Selected,NoSelected); + SetLength(ColLabels,NoSelected); + SetLength(ColMeans,NoSelected); + SetLength(ColVar,NoSelected); + SetLength(RowMeans,NoCases); + SetLength(RowVar,NoCases); + + for i := 0 to NoSelected - 1 do + begin + LabelStr := SelList.Items[i]; + for j := 1 to NoVariables do + if LabelStr = OS3MainFrm.DataGrid.Cells[j, 0] then + begin + Selected[i] := j; + ColLabels[i] := labelStr; + break; + end; + end; + + // Initialize values + SScols := 0.0; + SSrows := 0.0; + SStot := 0.0; + dfwrows := 0.0; + dftot := 0.0; + GrandMean := 0.0; + count := 0; + + for i := 0 to NoSelected-1 do + begin + ColMeans[i] := 0.0; + ColVar[i] := 0.0; + end; + for j := 0 to NoCases-1 do + begin + RowMeans[j] := 0.0; + RowVar[j] := 0.0; + end; + + // Read data and compute sums while reading + row := 0; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,Selected) then continue; + count := count + 1; + for j := 1 to NoSelected do + begin + k := Selected[j-1]; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i])); + RowMeans[row] := RowMeans[row] + X; + RowVar[row] := RowVar[row] + (X * X); + ColMeans[j-1] := ColMeans[j-1] + X; + ColVar[j-1] := ColVar[j-1] + (X * X); + GrandMean := GrandMean + X; + SStot := SStot + (X * X); + end; + row := row + 1; + end; + + // Calculate ANOVA results + Term1 := (GrandMean * GrandMean) / (count * NoSelected); + Term2 := SStot; + for i := 1 to count do SSrows := SSrows + (RowMeans[i-1] * RowMeans[i-1]); + Term4 := SSrows / NoSelected; + for i := 1 to NoSelected do SScols := SScols + (ColMeans[i-1] * ColMeans[i-1]); + Term3 := SScols / count; + SSrows := Term4 - Term1; + SScols := Term3 - Term1; + SSwrows := Term2 - Term4; + SSerr := Term2 - Term3 - Term4 + Term1; + SStot := Term2 - Term1; + dfrows := count - 1; + dfcols := NoSelected - 1; + dfwrows := count * (NoSelected - 1); + dferr := (count - 1) * (NoSelected - 1); + dftot := (count * NoSelected) - 1; + MSrows := SSrows / dfrows; + MScols := SScols / dfcols; + MSwrows := SSwrows / dfwrows; + MSerr := SSerr / dferr; + MStot := SStot / dftot; // variance of all scores + GrandMean := GrandMean / (count * NoSelected); + for i := 0 to count-1 do + begin + RowVar[i] := RowVar[i] - (RowMeans[i] * RowMeans[i] / NoSelected); + RowVar[i] := RowVar[i] / (NoSelected - 1); + RowMeans[i] := RowMeans[i] / NoSelected; + end; + for i := 0 to NoSelected-1 do + begin + ColVar[i] := ColVar[i] - (ColMeans[i] * ColMeans[i] / count); + ColVar[i] := ColVar[i] / (count - 1); + ColMeans[i] := ColMeans[i] / count; + end; + f1 := MScols / MSerr; // treatment F statistic + probf1 := probf(f1,dfcols,dferr); + + // Do reliability terms if requested + if RelChk.Checked then + begin + r1 := 1.0 - (MSwrows / MSrows); // unadjusted reliability of test + r2 := (MSrows - MSwrows) / (MSrows + (NoSelected - 1) * MSwrows); + // r2 is unadjusted reliability of a single item + r3 := (MSrows - MSerr) / MSrows; // Cronbach alpha for test + r4 := (MSrows - MSerr) / (MSrows + (NoSelected - 1) * MSerr); + // r4 is adjusted reliability of a single item + end; + + // do homogeneity of variance and covariance checks if requested + + lReport := TStringList.Create; + try + // print results + lReport.Add('Treatments by Subjects (AxS) ANOVA Results.'); + lReport.Add(''); + lReport.Add('Data File = ' + OS3MainFrm.FileNameEdit.Text); + lReport.Add(''); + lReport.Add(''); + lReport.Add('-----------------------------------------------------------'); + lReport.Add('SOURCE DF SS MS F Prob. > F'); + lReport.Add('-----------------------------------------------------------'); + lReport.Add('SUBJECTS %4.0f%10.3f%10.3f', [dfrows, SSrows, MSrows]); + lReport.Add('WITHIN SUBJECTS%4.0f%10.3f%10.3f', [dfwrows, SSwrows, MSwrows]); + lReport.Add(' TREATMENTS %4.0f%10.3f%10.3f%10.3f%10.3f', [dfcols, SScols, MScols, f1, probf1]); + lReport.Add(' RESIDUAL %4.0f%10.3f%10.3f', [dferr, SSerr, MSerr]); + lReport.Add('-----------------------------------------------------------'); + lReport.Add('TOTAL %4.0f%10.3f%10.3f', [dftot, SStot, MStot]); + lReport.Add('-----------------------------------------------------------'); + lReport.Add(''); + lReport.Add(''); + lReport.Add('TREATMENT (COLUMN) MEANS AND STANDARD DEVIATIONS'); + lReport.Add('VARIABLE MEAN STD.DEV.'); + for i := 1 to NoSelected do + lReport.Add('%-8s%10.3f%10.3f', [ColLabels[i-1], ColMeans[i-1], sqrt(ColVar[i-1])]); + lReport.Add(''); + lReport.Add('Mean of all scores = %.3f with standard deviation = %.3f', [GrandMean, sqrt(MStot)]); + lReport.Add(''); + lReport.Add(''); + + // Do reliability estimates if requested + if RelChk.Checked then + begin + lReport.Add('RELIABILITY ESTIMATES'); + lReport.Add(''); + lReport.Add('TYPE OF ESTIMATE VALUE'); + lReport.Add('Unadjusted total reliability %7.3f', [r1]); + lReport.Add('Unadjusted item reliability %7.3f', [r2]); + lReport.Add('Adjusted total (Cronbach) %7.3f', [r3]); + lReport.Add('Adjusted item reliability %7.3f', [r4]); + lReport.Add(''); + lReport.Add(''); + end; + + // Test assumptions of variance - covariance homogeneity if requested + if AssumpChk.Checked then + begin + SetLength(varcovmat,NoSelected+1,NoSelected+1); + SetLength(vcmat,NoSelected+1,NoSelected+1); + SetLength(workmat,NoSelected+1,NoSelected+1); + SetLength(ColStdDev,NoSelected); + errorfound := false; + count := NoCases; + lReport.Add('BOX TEST FOR HOMOGENEITY OF VARIANCE-COVARIANCE MATRIX'); + lReport.Add(''); + GridCovar(NoSelected, Selected, varcovmat, ColMeans, ColVar, ColStdDev, errorfound, count); + title := 'SAMPLE COVARIANCE MATRIX'; + MatPrint(varcovmat, NoSelected, NoSelected, title, ColLabels, ColLabels, NoCases, lReport); + if errorfound then + MessageDlg('Zero variance found for a variable.', mtError, [mbOK], 0); + + // get average of variances into workmat diagonal and average of + // covariances into workmat off-diagonals (See Winer, pg 371) + avgvar := 0.0; + avgcov := 0.0; + for i := 0 to NoSelected-1 do + vcmat[i,i] := varcovmat[i,i]; + for i := 0 to NoSelected-2 do + begin + for j := i+1 to NoSelected-1 do + begin + vcmat[i,j] := varcovmat[i,j]; + vcmat[j,i] := vcmat[i,j]; + end; + end; + + for i := 0 to NoSelected-1 do + avgvar := avgvar + varcovmat[i,i]; + for i := 0 to NoSelected-2 do + for j := i+1 to NoSelected-1 do + avgcov := avgcov + varcovmat[i,j]; + avgvar := avgvar / NoSelected; + avgcov := avgcov / (NoSelected * NoSelected - 1) / 2.0; + for i := 0 to NoSelected-1 do + workmat[i,i] := avgvar; + for i := 0 to NoSelected-2 do + begin + for j := i+1 to NoSelected-1 do + begin + workmat[i,j] := avgcov; + workmat[j,i] := workmat[i,j]; + end; + end; + + // get determinants of varcov and workmat + determ1 := 0.0; + determ2 := 0.0; + M2 := 0.0; + C2 := 0.0; + chi2 := 0.0; + f2 := 0; + prob := 0.0; + Determ(vcmat,NoSelected,NoSelected,determ1,errorfound); + if determ1 < 0.0 then determ1 := 0.0; + Determ(workmat,NoSelected,NoSelected,determ2,errorfound); + if determ2 < 0.0 then determ2 := 0.0; + count := NoCases; + GridCovar(NoSelected,Selected,varcovmat,ColMeans,ColVar,ColStdDev,errorfound,count); + errorfound := false; + if ((determ1 > 0.0) and (determ2 > 0.0)) then + M2 := -(NoCases*NoSelected - 1) * ln(determ1 / determ2) + else + begin + M2 := 0.0; + errorfound := true; + MessageDlg('A determinant <= zero was found.', mtError, [mbOK], 0); + end; + if not errorfound then + begin + C2 := NoSelected * (NoSelected+1) * (NoSelected + 1) * (2 * NoSelected - 3); + C2 := C2 / (6 * (count - 1)*(NoSelected - 1) * (NoSelected * NoSelected + NoSelected - 4)); + chi2 := (1.0 - C2) * M2; + f3 := (NoSelected * NoSelected + NoSelected - 4) div 2; + if ((chi2 > 0.01) and (chi2 < 1000.0)) then + prob := chisquaredprob(chi2,f3) + else + begin + if chi2 <= 0.0 then prob := 1.0; + if chi2 >= 1000.0 then prob := 0.0; + end; + end; + title := 'ASSUMED POP. COVARIANCE MATRIX'; + for i := 0 to NoSelected-1 do + for j := 0 to NoSelected-1 do + varcovmat[i,j] := workmat[i,j]; + MatPrint(varcovmat, NoSelected, NoSelected, title, ColLabels, ColLabels, NoCases, lReport); + lReport.Add('Determinant of variance-covariance matrix = %10.3g', [determ1]); + lReport.Add('Determinant of homogeneity matrix = %10.3g', [determ2]); + if not errorfound then + begin + lReport.Add('ChiSquare = %10.3f with %3d degrees of freedom', [chi2,f3]); + lReport.Add('Probability of larger chisquare = %6.3g', [1.0-prob]); + end; + end; + + DisplayReport(lReport); + + finally + lReport.Free; + ColStdDev := nil; + workmat := nil; + vcmat := nil; + varcovmat := nil; + end; + + { Now, plot values if indicated in options list } + if PlotChk.Checked then + begin + SetLength(GraphFrm.Xpoints,1,NoSelected); + SetLength(GraphFrm.Ypoints,1,NoSelected); + + // use rowvar to hold variable no. + for i := 1 to NoSelected do + begin + rowvar[i-1] := Selected[i-1]; + GraphFrm.Xpoints[0,i-1] := Selected[i-1]; + GraphFrm.Ypoints[0,i-1] := ColMeans[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NoSelected; + GraphFrm.Heading := 'WITHIN SUBJECTS ANOVA'; + GraphFrm.XTitle := 'Repeated Measure Var. No.'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := true; + GraphFrm.GraphType := 2; // 3d Vertical Bar Chart + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; + + // Clean-up + RowVar := nil; + RowMeans := nil; + ColVar := nil; + ColMeans := nil; + ColLabels := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + Selected := nil; +end; + +procedure TWithinANOVAFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + SelList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TWithinANOVAFrm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < SelList.Items.Count do + begin + if SelList.Selected[i] then + begin + VarList.Items.Add(SelList.Items[i]); + SelList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + VarList.ItemIndex := -1; + SelList.ItemIndex := -1; + UpdateBtnStates; +end; + +procedure TWithinANOVAFrm.UpdateBtnStates; +var + i: Integer; + lEnabled: Boolean; +begin + lEnabled := false; + for i:=0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lEnabled := true; + break; + end; + InBtn.Enabled := lEnabled; + + lEnabled := false; + for i:=0 to SelList.Items.Count-1 do + if SelList.Selected[i] then + begin + lEnabled := true; + break; + end; + OutBtn.Enabled := lEnabled; +end; + +procedure TWithinANOVAFrm.VarListSelectionChange(Sender: TObject; + User: boolean); +begin + UpdateBtnStates; +end; + + +initialization + {$I withinanovaunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/correlation/autocorunit.lfm b/applications/lazstats/source/forms/analysis/correlation/autocorunit.lfm new file mode 100644 index 000000000..212c036de --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/autocorunit.lfm @@ -0,0 +1,708 @@ +object AutoCorrFrm: TAutoCorrFrm + Left = 456 + Height = 459 + Top = 163 + Width = 684 + AutoSize = True + Caption = 'Autocorrelation' + ClientHeight = 459 + ClientWidth = 684 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 68 + Top = 8 + Width = 137 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'The series is code in:' + ClientHeight = 48 + ClientWidth = 133 + TabOrder = 0 + object ColBtn: TRadioButton + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + Left = 16 + Height = 19 + Top = 0 + Width = 99 + BorderSpacing.Left = 16 + Caption = 'A Grid Column' + OnClick = ColBtnClick + TabOrder = 0 + end + object RowBtn: TRadioButton + AnchorSideLeft.Control = ColBtn + AnchorSideTop.Control = ColBtn + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 19 + Top = 21 + Width = 109 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'A row of the grid' + OnClick = RowBtnClick + TabOrder = 1 + end + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + Left = 169 + Height = 68 + Top = 8 + Width = 275 + AutoSize = True + BorderSpacing.Left = 24 + BorderSpacing.Top = 8 + Caption = 'Include Cases:' + ClientHeight = 48 + ClientWidth = 271 + TabOrder = 1 + object Label1: TLabel + AnchorSideLeft.Control = FromCaseEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = OnlyCasesBtn + AnchorSideTop.Side = asrCenter + Left = 189 + Height = 15 + Top = 23 + Width = 12 + BorderSpacing.Left = 4 + Caption = 'To' + ParentColor = False + end + object AllCasesBtn: TRadioButton + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = GroupBox2 + Left = 12 + Height = 19 + Top = 0 + Width = 67 + BorderSpacing.Left = 12 + Caption = 'All Cases' + TabOrder = 0 + end + object OnlyCasesBtn: TRadioButton + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = AllCasesBtn + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 21 + Width = 112 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 8 + Caption = 'Only Cases From:' + TabOrder = 1 + end + object FromCaseEdit: TEdit + AnchorSideLeft.Control = OnlyCasesBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = OnlyCasesBtn + AnchorSideTop.Side = asrCenter + Left = 128 + Height = 23 + Top = 19 + Width = 57 + Alignment = taRightJustify + BorderSpacing.Left = 4 + TabOrder = 2 + Text = 'FromCaseEdit' + end + object ToCaseEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = OnlyCasesBtn + AnchorSideTop.Side = asrCenter + Left = 205 + Height = 23 + Top = 19 + Width = 58 + Alignment = taRightJustify + BorderSpacing.Left = 4 + BorderSpacing.Right = 8 + TabOrder = 3 + Text = 'ToCaseEdit' + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 387 + Height = 25 + Top = 426 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 453 + Height = 25 + Top = 426 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 6 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 527 + Height = 25 + Top = 426 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + ModalResult = 1 + OnClick = ComputeBtnClick + TabOrder = 7 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 615 + Height = 25 + Top = 426 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 8 + end + object HelpBtn: TButton + Tag = 104 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 324 + Height = 25 + Top = 426 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 4 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 410 + Width = 684 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = GroupBox2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 326 + Top = 84 + Width = 447 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BevelOuter = bvNone + ClientHeight = 326 + ClientWidth = 447 + TabOrder = 2 + object Label3: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 100 + Caption = 'Available Variables:' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = DepVarEdit + AnchorSideBottom.Control = DepVarEdit + Left = 301 + Height = 15 + Top = 25 + Width = 88 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Selected Variable' + ParentColor = False + end + object Label5: TLabel + AnchorSideTop.Control = AlphaEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = AlphaEdit + Left = 311 + Height = 15 + Top = 93 + Width = 67 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Alpha Level: ' + ParentColor = False + end + object Label6: TLabel + AnchorSideTop.Control = MaxLagEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = MaxLagEdit + Left = 295 + Height = 15 + Top = 120 + Width = 83 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Maximum Lag: ' + ParentColor = False + end + object GroupBox3: TGroupBox + AnchorSideLeft.Control = InBtn + AnchorSideTop.Control = MaxLagEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 265 + Height = 51 + Top = 163 + Width = 182 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 24 + Caption = 'Projection Option:' + ClientHeight = 31 + ClientWidth = 178 + TabOrder = 6 + object Label2: TLabel + AnchorSideLeft.Control = ProjPtsEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ProjPtsEdit + AnchorSideTop.Side = asrCenter + Left = 135 + Height = 15 + Top = 6 + Width = 33 + BorderSpacing.Left = 8 + BorderSpacing.Right = 16 + BorderSpacing.Bottom = 8 + Caption = 'Points' + ParentColor = False + end + object ProjectChk: TCheckBox + AnchorSideLeft.Control = GroupBox3 + AnchorSideTop.Control = ProjPtsEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 19 + Top = 4 + Width = 57 + BorderSpacing.Left = 12 + Caption = 'Project' + TabOrder = 0 + end + object ProjPtsEdit: TEdit + AnchorSideLeft.Control = ProjectChk + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox3 + Left = 85 + Height = 23 + Top = 2 + Width = 42 + Alignment = taRightJustify + BorderSpacing.Left = 16 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 6 + TabOrder = 1 + end + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 309 + Top = 17 + Width = 257 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + Left = 265 + Height = 28 + Top = 17 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = InBtn + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 265 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object DepVarEdit: TEdit + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = OutBtn + AnchorSideBottom.Side = asrBottom + Left = 301 + Height = 23 + Top = 42 + Width = 146 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 3 + Text = 'DepVarEdit' + end + object AlphaEdit: TEdit + AnchorSideTop.Control = DepVarEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 386 + Height = 23 + Top = 89 + Width = 61 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 24 + TabOrder = 4 + Text = 'AlphaEdit' + end + object MaxLagEdit: TEdit + AnchorSideTop.Control = AlphaEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 386 + Height = 23 + Top = 116 + Width = 61 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + TabOrder = 5 + Text = 'MaxLagEdit' + end + object Bevel2: TBevel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel1 + Left = 182 + Height = 12 + Top = 0 + Width = 83 + Shape = bsSpacer + end + end + object Panel2: TPanel + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 463 + Height = 357 + Top = 6 + Width = 213 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 357 + ClientWidth = 213 + TabOrder = 3 + object GroupBox4: TGroupBox + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = GroupBox5 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 177 + Top = 180 + Width = 213 + AutoSize = True + BorderSpacing.Top = 16 + Caption = 'Data Smoothing:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 157 + ClientWidth = 209 + TabOrder = 1 + object MeanChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 185 + Caption = 'Center on Mean' + TabOrder = 0 + end + object DifferenceChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 185 + Caption = 'Difference Smoothing' + TabOrder = 1 + end + object MoveAvgChk: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 185 + Caption = 'Moving Average Smooth' + TabOrder = 2 + end + object ExpSmoothChk: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 185 + Caption = 'Exponentially Smooth' + TabOrder = 3 + end + object FourierSmoothChk: TCheckBox + Left = 12 + Height = 19 + Top = 90 + Width = 185 + Caption = 'Fourier Filter Smooth' + TabOrder = 4 + end + object PolyChk: TCheckBox + Left = 12 + Height = 19 + Top = 111 + Width = 185 + Caption = 'Polynomial Regression Smooth' + TabOrder = 5 + end + object MRegSmoothChk: TCheckBox + Left = 12 + Height = 19 + Top = 132 + Width = 185 + Caption = 'Multiple Regression Smooth' + TabOrder = 6 + end + end + object GroupBox5: TGroupBox + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = GroupBox4 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 156 + Top = 8 + Width = 213 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 8 + Caption = 'Analysis / Output Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 136 + ClientWidth = 209 + TabOrder = 0 + object PlotChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 142 + Caption = 'Correlogram' + TabOrder = 0 + end + object StatsChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 142 + Caption = 'Statistics' + TabOrder = 1 + end + object RMatChk: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 142 + Caption = 'Print correlation Mat.' + TabOrder = 2 + end + object PartialsChk: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 142 + Caption = 'Partial autocorrelations' + TabOrder = 3 + end + object YuleWalkerChk: TCheckBox + Left = 12 + Height = 19 + Top = 90 + Width = 142 + Caption = 'Yule-Walker Coef.s' + TabOrder = 4 + end + object ResidChk: TCheckBox + Left = 12 + Height = 19 + Top = 111 + Width = 142 + Caption = 'Residual Plot' + TabOrder = 5 + end + end + end +end diff --git a/applications/lazstats/source/forms/analysis/correlation/autocorunit.pas b/applications/lazstats/source/forms/analysis/correlation/autocorunit.pas new file mode 100644 index 000000000..4beb0cac8 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/autocorunit.pas @@ -0,0 +1,1259 @@ +unit AutoCorUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, + MainUnit, FunctionsLib, OutputUnit, Globals, GraphLib, DataProcs, MatrixLib, + PointsUnit, ExpSmoothUnit, DifferenceUnit, FFTUnit, PolynomialUnit, + ContextHelpUnit; + +type + + { TAutoCorrFrm } + + TAutoCorrFrm = class(TForm) + AlphaEdit: TEdit; + Bevel1: TBevel; + Bevel2: TBevel; + HelpBtn: TButton; + Panel1: TPanel; + Panel2: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + PlotChk: TCheckBox; + StatsChk: TCheckBox; + RMatChk: TCheckBox; + PartialsChk: TCheckBox; + YuleWalkerChk: TCheckBox; + ResidChk: TCheckBox; + GroupBox5: TGroupBox; + MaxLagEdit: TEdit; + InBtn: TBitBtn; + Label5: TLabel; + Label6: TLabel; + OutBtn: TBitBtn; + DepVarEdit: TEdit; + Label3: TLabel; + Label4: TLabel; + VarList: TListBox; + MRegSmoothChk: TCheckBox; + PolyChk: TCheckBox; + FourierSmoothChk: TCheckBox; + ExpSmoothChk: TCheckBox; + MoveAvgChk: TCheckBox; + DifferenceChk: TCheckBox; + MeanChk: TCheckBox; + GroupBox4: TGroupBox; + Label2: TLabel; + ProjPtsEdit: TEdit; + ProjectChk: TCheckBox; + FromCaseEdit: TEdit; + GroupBox3: TGroupBox; + ToCaseEdit: TEdit; + GroupBox1: TGroupBox; + GroupBox2: TGroupBox; + Label1: TLabel; + ColBtn: TRadioButton; + AllCasesBtn: TRadioButton; + OnlyCasesBtn: TRadioButton; + RowBtn: TRadioButton; + procedure ColBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure RowBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + procedure four1(VAR data : DblDyneVec; nn : longword; isign : integer); + procedure RealFT(VAR data : DblDyneVec; n : longword; isign : integer); + procedure Fourier(VAR data : DblDyneVec; n : integer; npts : integer); + procedure PolyFit(VAR pts : DblDyneVec; VAR avg : DblDyneVec; + NoPts : integer); + + end; + +var + AutoCorrFrm: TAutoCorrFrm; + +implementation + +uses + Math, + MoveAvgUnit, AutoPlotUnit; + +{ TAutoCorrFrm } + +procedure TAutoCorrFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + DepVarEdit.Text := ''; + MaxLagEdit.Text := '30'; + StatsChk.Checked := false; + RmatChk.Checked := false; + PartialsChk.Checked := false; + PlotChk.Checked := true; + ResidChk.Checked := false; + DifferenceChk.Checked := false; + PolyChk.Checked := false; + MeanChk.Checked := false; + MoveAvgChk.Checked := false; + ExpSmoothChk.Checked := false; + FourierSmoothChk.Checked := false; + YuleWalkerChk.Checked := false; + FromCaseEdit.Text := ''; + ToCaseEdit.Text := ''; + AllCasesBtn.Checked := true; + InBtn.Enabled := true; + OutBtn.Enabled := false; + AlphaEdit.Text := '0.05'; + ProjPtsEdit.Text := ''; + if ColBtn.Checked = true then + begin + for i := 1 to OS3MainFrm.DataGrid.ColCount - 1 do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + end + else begin + for i := 1 to NoCases do + begin + if IsFiltered(i) then continue; + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[0,i]); + end; + end; +end; + +procedure TAutoCorrFrm.ReturnBtnClick(Sender: TObject); +begin + Close; +end; + +procedure TAutoCorrFrm.RowBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + for i := 1 to NoCases do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[0,i]); + GroupBox2.Caption := 'Include Columns:'; + AllCasesBtn.Caption := 'All Variables'; + OnlyCasesBtn.Caption := 'Only Columns From:'; +end; + +procedure TAutoCorrFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Panel1.Constraints.MinWidth := GroupBox2.Left + GroupBox2.Width - Panel1.Left; + Panel1.Constraints.MinHeight := Panel2.Top + Panel2.Height - Panel1.Top; + + Constraints.MinHeight := Height; + Constraints.MinWidth := Width; + Constraints.MaxWidth := Width; + + FAutoSized := true; +end; + +procedure TAutoCorrFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); + if PointsFrm = nil then Application.CreateForm(TPointsFrm, PointsFrm); +end; + +procedure TAutoCorrFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TAutoCorrFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TAutoCorrFrm.ComputeBtnClick(Sender: TObject); +var + X, Y, count, covzero, mean : double; + uplimit, lowlimit, varresid, StdErr, alpha: double; + NoPts, DepVar, maxlag, lag, noproj : integer; + i, j, k, ncors, npoints, nvalues, t : integer; + Means, StdDevs, PartCors, residual, betas, rxy, pts, avg : DblDyneVec; + correlations, a : DblDyneMat; + RowLabels, ColLabels : StrDyneVec; + Title : string; + r, vx, vy, sx, sy, mx, my, UCL, LCL, Yhat, Constant : double; + outline, cellstring : string; + ColNoSelected : IntDyneVec; + NoSelected : integer; + Msg : string; + zconf, samptrans, z : double; + confidence, StdDevY : double; + //upper : array[0..300] of double; + lagvalue : array[0..300] of integer; + +begin + OutputFrm.RichEdit.Clear; + + SetLength(ColNoSelected,NoVariables); + if ColBtn.Checked = true then + begin + // get column of the selected variable + DepVar := 0; + for i := 1 to NoVariables do + if (OS3MainFrm.DataGrid.Cells[i,0] = DepVarEdit.Text) then DepVar := i; + if (DepVar = 0)then + begin + ShowMessage('No variable selected to analyze.'); + exit; + end; + ColNoSelected[0] := DepVar; + NoSelected := 1; + // get no. of valid points + NoPts := 0; + for i := 1 to NoCases do + if ValidValue(i,DepVar) then NoPts := NoPts + 1; + end + else begin // get row of the selected case + DepVar := 0; + for i := 1 to NoCases do + begin + if NOT GoodRecord(i,NoSelected,ColNoSelected) then continue; + if (OS3MainFrm.DataGrid.Cells[0,i] = DepVarEdit.Text) then DepVar := i; + end; + if (DepVar = 0)then + begin + ShowMessage('No variable selected to analyze.'); + exit; + end; + ColNoSelected[0] := DepVar; + NoSelected := 1; + NoPts := NoVariables; + end; + + // Get the alpha level and the maximum lag values + alpha := 1.0 - StrToFloat(AlphaEdit.Text); + if ProjectChk.Checked then noproj := StrToInt(ProjPtsEdit.Text) else noproj := 0; + maxlag := StrToInt(MaxLagEdit.Text); + if maxlag > NoPts div 2 then maxlag := NoPts div 2; + if StrToInt(MaxLagEdit.Text) > maxlag then MaxLagEdit.Text := IntToStr(maxlag); + npoints := maxlag + 2; + + // allocate space for covariance and correlation matrices, etc. + SetLength(correlations,npoints+1,npoints+1); + SetLength(Means,npoints); + SetLength(StdDevs,npoints); + SetLength(RowLabels,npoints); + SetLength(ColLabels,npoints); + SetLength(PartCors,npoints); + SetLength(a,npoints,npoints); + SetLength(betas,npoints); + SetLength(rxy,npoints); + SetLength(pts,NoPts+noproj+10); + SetLength(avg,NoPts+noproj+10); + SetLength(residual,NoPts+noproj+10); + + // Initialize arrays + for i := 0 to npoints-1 do + begin + for j := 0 to npoints - 1 do + begin + correlations[i,j] := 0.0; + a[i,j] := 0.0; + end; + Means[i] := 0.0; + StdDevs[i] := 0.0; + cellstring := 'Lag '; + cellstring := cellstring + IntToStr(i); + RowLabels[i] := cellstring; + ColLabels[i] := RowLabels[i]; + PartCors[i] := 0.0; + betas[i] := 0.0; + end; + uplimit := 0.0; + lowlimit := 0.0; + covzero := 0.0; + + // Get points to analyze + if ColBtn.Checked = true then + begin + if AllCasesBtn.Checked = true then + begin + for i := 1 to NoPts do + begin + if NOT ValidValue(i,DepVar) then continue; + pts[i-1] := StrToFloat(OS3MainFrm.DataGrid.Cells[DepVar,i]); + end; + end + else begin + NoPts := 0; + for i := StrToInt(FromCaseEdit.Text) to StrToInt(ToCaseEdit.Text) do + begin + if NOT ValidValue(i,DepVar) then continue; + pts[NoPts] := StrToFloat(OS3MainFrm.DataGrid.Cells[DepVar,i]); + NoPts := NoPts + 1; + end; + end; + end + else begin // row button selected + if AllCasesBtn.Checked = true then + begin + for i := 1 to NoPts do + begin + if Not ValidValue(DepVar,i) then continue; + pts[i-1] := StrToFloat(OS3MainFrm.DataGrid.Cells[i,DepVar]); + end; + end + else begin + NoPts := 0; + for i := StrToInt(FromCaseEdit.Text) to StrToInt(ToCaseEdit.Text) do + begin + if Not ValidValue(DepVar,i) then continue; + pts[NoPts] := StrToFloat(OS3MainFrm.DataGrid.Cells[i,DepVar]); + NoPts := NoPts + 1; + end; + end; + end; + + // Calculate mean of all values + mean := 0.0; + count := NoPts; + for i := 1 to NoPts do mean := mean + pts[i-1]; + + correlations[0,0] := 1.0; + mean := mean / count; + + // Remove mean from all observations if elected + if (MeanChk.Checked) then + for i := 1 to NoPts do pts[i-1] := pts[i-1] - mean; + + // Get differences for lag specified + if (DifferenceChk.Checked) then + begin + if DifferenceFrm = nil then + Application.CreateForm(TDifferenceFrm, DifferenceFrm); + if (DifferenceFrm.ShowModal = mrOK) then + begin + lag := StrToInt(DifferenceFrm.LagEdit.Text); + for i := 0 to NoPts - 1 do avg[i] := pts[i]; + for j := 1 to StrToInt(DifferenceFrm.OrderEdit.Text) do + begin + for i := NoPts downto lag do + begin + avg[i] := avg[i] - avg[i-lag]; + end; + end; + end; + // plot the original and differenced values + PointsFrm.pts := pts; + PointsFrm.avg := avg; + PointsFrm.NoCases := NoPts; + PointsFrm.LabelOne := 'Original'; + PointsFrm.LabelTwo := 'Differenced'; + Msg := 'No. points = '; + Msg := Msg + IntToStr(NoCases); + PointsFrm.MsgEdit.Text := Msg; + PointsFrm.Title := 'Differencing Smoothed'; + PointsFrm.Caption := 'Difference Smoothing'; + PointsFrm.ShowModal; +// PointsFrm.PtsPlot(self); + if (ResidChk.Checked = true) then // calculate and plot residuals; + begin + varresid := 0.0; + for i := 0 to NoPts - 1 do + begin + residual[i] := pts[i] - avg[i]; + varresid := varresid + (residual[i] * residual[i]); + end; + varresid := varresid / NoPts; + StdErr := sqrt(varresid); + // plot the residuals + PointsFrm.pts := pts; + PointsFrm.avg := residual; + PointsFrm.NoCases := NoPts; + Msg := 'Std. Err. Residuals = '; + Msg := Msg + FloatToStr(StdErr); + PointsFrm.MsgEdit.Text := Msg; + PointsFrm.LabelOne := 'Original'; + PointsFrm.LabelTwo := 'Residuals'; + PointsFrm.Title := 'Residuals from Difference Smoothing'; + PointsFrm.Caption := 'Difference Residuals'; + PointsFrm.ShowModal; +// PointsFrm.PtsPlot(self); + end; + // replace original points with smoothed values + for i := 0 to NoPts - 1 do + pts[i] := avg[i]; + end; + + // Get moving average if checked + if (MoveAvgChk.Checked) then + begin + if MoveAvgFrm = nil then + Application.CreateForm(TMoveAvgFrm, MoveAvgFrm); + MoveAvgFrm.ShowModal; + nvalues := MoveAvgFrm.order; + if (nvalues > 0) then + begin + // plot the original points and the smoothed average + for i := nvalues to NoPts - nvalues - 1 do + begin + avg[i] := pts[i] * MoveAvgFrm.W[0]; // middle value + for j := 1 to nvalues do // left values + avg[i] := avg[i] + (pts[i-j] * MoveAvgFrm.W[j]); + for j := 1 to nvalues do // right values + avg[i] := avg[i] + (pts[i+j] * MoveAvgFrm.W[j]); + end; + // fill in unestimable averages with original points + for i := 0 to nvalues - 1 do // left values + begin + avg[i] := pts[i] * MoveAvgFrm.W[0]; + for j := 1 to nvalues do + avg[i] := avg[i] + (pts[i+j] * 2.0 * MoveAvgFrm.W[j]); + end; + for i := NoPts - nvalues to NoPts - 1 do //right values + begin + avg[i] := pts[i] * MoveAvgFrm.W[0]; + for j := 1 to nvalues do + avg[i] := avg[i] + (pts[i-j] * 2.0 * MoveAvgFrm.W[j]); + end; + if ProjectChk.Checked then + begin + for i := 0 to noproj-1 do + begin + avg[NoPts+i] := avg[NoPts-1]; + pts[NoPts+i] := pts[NoPts-1]; + end; + end; + // plot the points + PointsFrm.pts := pts; + PointsFrm.avg := avg; + PointsFrm.NoCases := NoPts+noproj; + PointsFrm.LabelOne := 'Original'; + PointsFrm.LabelTwo := 'Smoothed'; + Msg := 'No. points = '; + Msg := Msg + IntToStr(NoPts); + PointsFrm.MsgEdit.Text := Msg; + PointsFrm.Title := 'Moving Average Smoothed'; + PointsFrm.Caption := 'Moving Average Smoothing'; + PointsFrm.ShowModal; + end; + if (ResidChk.Checked = true) then // calculate and plot residuals; + begin + varresid := 0.0; + for i := 0 to NoPts - 1 do + begin + residual[i] := pts[i] - avg[i]; + varresid := varresid + (residual[i] * residual[i]); + end; + varresid := varresid / NoPts; + StdErr := sqrt(varresid); + // plot the residuals + PointsFrm.pts := pts; + PointsFrm.avg := residual; + PointsFrm.NoCases := NoPts; + Msg := 'Std. Err. Residuals = '; + Msg := Msg + FloatToStr(StdErr); + PointsFrm.MsgEdit.Text := Msg; + PointsFrm.LabelOne := 'Original'; + PointsFrm.LabelTwo := 'Residuals'; + PointsFrm.Title := 'Residuals from Moving Average'; + PointsFrm.Caption := 'Moving Average Residuals'; + PointsFrm.ShowModal; +// PointsFrm.PtsPlot(self); + end; + // replace original points with smoothed values + for i := 0 to (NoPts + noproj - 1) do pts[i] := avg[i]; + end; + + // do exponential smoothing if requested + if (ExpSmoothChk.Checked = true) then + begin + if ExpSmoothFrm = nil then + Application.CreateForm(TExpSmoothFrm, ExpSmoothFrm); + ExpSmoothFrm.ShowModal; + alpha := ExpSmoothFrm.alpha; + avg[0] := pts[0]; // set first value := to observed + for t := 1 to NoPts - 1 do // case pointer + begin + avg[t] := alpha * pts[t]; + avg[t] := avg[t] + (1.0 - alpha) * avg[t-1]; + end; + if ProjectChk.Checked then + begin + for i := 0 to noproj-1 do + begin + avg[NoPts+i] := alpha * pts[NoPts+i-1]; + avg[NoPts+i] := avg[NoPts+i] + ((1.0 - alpha) * avg[NoPts+i-1]); + pts[NoPts+i] := avg[NoPts+i]; + end; + end; + // plot the points + PointsFrm.pts := pts; + PointsFrm.avg := avg; + PointsFrm.NoCases := NoPts+noproj; + PointsFrm.LabelOne := 'Original'; + PointsFrm.LabelTwo := 'Smoothed'; + PointsFrm.Title := 'Exponential Smoothed'; + PointsFrm.Caption := 'Exponential Smoothing'; + PointsFrm.ShowModal; +// PointsFrm.PtsPlot(self); + if (ResidChk.Checked = true) then // calculate and plot residuals; + begin + varresid := 0.0; + for i := 0 to NoPts - 1 do + begin + residual[i] := pts[i] - avg[i]; + varresid := varresid + (residual[i] * residual[i]); + end; + varresid := varresid / NoPts; + StdErr := sqrt(varresid); + // plot the residuals + PointsFrm.pts := pts; + PointsFrm.avg := residual; + PointsFrm.NoCases := NoPts; + Msg := 'Std. Err. Residuals = '; + Msg := Msg + FloatToStr(StdErr); + PointsFrm.MsgEdit.Text := Msg; + PointsFrm.LabelOne := 'Original'; + PointsFrm.LabelTwo := 'Residuals'; + PointsFrm.Title := 'Residuals from Exponential Smoothing'; + PointsFrm.Caption := 'Exponential Residuals'; + PointsFrm.ShowModal; +// PointsFrm.PtsPlot(self); + end; + // replace original points with smoothed values + for i := 0 to (NoPts + noproj - 1) do pts[i] := avg[i]; + end; + + // Fast Fourier smoothing, if requested + if (FourierSmoothChk.Checked = true) then + begin + for i := 0 to NoPts - 1 do avg[i] := pts[i]; + if ProjectChk.Checked then + begin + for i := 0 to noproj - 1 do + begin + avg[i] := pts[NoPts-1-noproj+i]; + pts[i] := avg[i]; + end; + end; + if FFTFrm = nil then + Application.CreateForm(TFFTFrm, FFTFrm); + FFTFrm.NptsEdit.Text := IntToStr(NoPts+noproj+1); + FFTFrm.ShowModal; + nvalues := StrToInt(FFTFrm.NptsEdit.Text); + fourier(avg,nvalues,nvalues); + PointsFrm.pts := pts; + PointsFrm.avg := avg; + PointsFrm.NoCases := NoPts+noproj; + PointsFrm.LabelOne := 'Original'; + PointsFrm.LabelTwo := 'Smoothed'; + PointsFrm.Title := 'Fourier Smoothed'; + PointsFrm.Caption := 'Fourier Smoothing'; + PointsFrm.ShowModal; +// PointsFrm.PtsPlot(self); + if (ResidChk.Checked = true) then // calculate and plot residuals; + begin + varresid := 0.0; + for i := 0 to NoPts - 1 do + begin + residual[i] := pts[i] - avg[i]; + varresid := varresid + (residual[i] * residual[i]); + end; + varresid := varresid / NoPts; + StdErr := sqrt(varresid); + // plot the residuals + PointsFrm.pts := pts; + PointsFrm.avg := residual; + PointsFrm.NoCases := NoPts; + Msg := 'Std. Err. Residuals = '; + Msg := Msg + FloatToStr(StdErr); + PointsFrm.MsgEdit.Text := Msg; + PointsFrm.LabelOne := 'Original'; + PointsFrm.LabelTwo := 'Residuals'; + PointsFrm.Title := 'Residuals from Fourier Smoothing'; + PointsFrm.Caption := 'Fourier Residuals'; + PointsFrm.ShowModal; +// PointsFrm.PtsPlot(self); + end; + // replace original points with smoothed values + for i := 0 to (NoPts + noproj - 1) do pts[i] := avg[i]; + end; + + // Get polynomial regression fit if elected + if (PolyChk.Checked) then + begin + if PolynomialFrm = nil then + Application.CreateForm(TPolynomialFrm, PolynomialFrm); + + if (PolynomialFrm.ShowModal = mrOk) then + begin + if ProjectChk.Checked then + begin + for i := 0 to noproj - 1 do + begin + avg[i] := pts[NoPts-1-noproj+i]; + pts[i] := avg[i]; + end; + end; + PolyFit(pts,avg,NoPts+noproj); + // plot original and smoothed data + PointsFrm.pts := pts; + PointsFrm.avg := avg; + PointsFrm.NoCases := NoPts+noproj; + PointsFrm.LabelOne := 'Original'; + PointsFrm.LabelTwo := 'Smoothed'; + PointsFrm.Title := 'Polynomial Smoothed'; + PointsFrm.Caption := 'Polynomial Smoothing'; + PointsFrm.ShowModal; +// PointsFrm.PtsPlot(self); + // plot residuals if checked + if (ResidChk.Checked) then + begin + varresid := 0.0; + for i := 0 to NoPts - 1 do + begin + residual[i] := pts[i] - avg[i]; + varresid := varresid + (residual[i] * residual[i]); + end; + varresid := varresid / NoPts; + StdErr := sqrt(varresid); + // plot the residuals + PointsFrm.pts := pts; + PointsFrm.avg := residual; + PointsFrm.NoCases := NoPts; + Msg := 'Std. Err. Residuals = '; + Msg := Msg + FloatToStr(StdErr); + PointsFrm.MsgEdit.Text := Msg; + PointsFrm.LabelOne := 'Original'; + PointsFrm.LabelTwo := 'Residuals'; + PointsFrm.Title := 'Residuals from Polynomial Smoothing'; + PointsFrm.Caption := 'Polynomial Residuals'; + PointsFrm.ShowModal; +// PointsFrm.PtsPlot(self); + end; + end; + + // replace original points with smoothed values + for i := 0 to (NoPts + noproj - 1) do pts[i] := avg[i]; + end; + + // get mean and variance of (transformed?) points + mean := 0.0; + for i := 0 to NoPts - 1 do mean := mean + pts[i]; + mean := mean / NoPts; + for i := 1 to NoPts do + begin + X := pts[i-1]; + if (MeanChk.Checked = true) then covzero := covzero + (X * X) + else covzero := covzero + ((X - mean) * (X - mean)); + end; + covzero := covzero / count; + + outline := format('Overall mean = %8.3f, variance = %8.3f',[mean,covzero]); + OutputFrm.RichEdit.Lines.Add(outline); + + // get correlations for each lag 0 to maxlag + confidence := StrToFloat(AlphaEdit.Text); + ncors := 0; + OutputFrm.RichEdit.Lines.Add('Lag Rxy MeanX MeanY Std.Dev.X Std.Dev.Y Cases LCL UCL'); + OutputFrm.RichEdit.Lines.Add(''); + if maxlag > NoPts-3 then + begin + maxlag := NoPts - 3; + maxlagedit.Text := IntToStr(maxlag); + end; + for lag := 0 to maxlag do + begin + r := 0.0; + vx := 0.0; + vy := 0.0; + mx := 0.0; + my := 0.0; + Count := 0.0; + lagvalue[lag] := lag; + for i := 1 to (NoPts - lag) do + begin + X := pts[i-1]; + Y := pts[i-1+lag]; + if (MeanChk.Checked = true) then r := r + (X * Y) + else r := r + ((X - mean) * (Y - mean)); + vx := vx + (X * X); + vy := vy + (Y * Y); + mx := mx + X; + my := my + Y; + Count := Count + 1.0; + end; + r := r / NoPts; + vx := vx - (mx * mx / Count); + vx := vx / (Count - 1.0); + sx := sqrt(vx); + vy := vy - (my * my / Count); + vy := vy / (Count - 1.0); + sy := sqrt(vy); + mx := mx / Count; + my := my / Count; + r := r / covzero; + if (abs(r) < 1.0) then samptrans := ln((1.0 + r) / (1.0 - r)) / 2.0; + // if above failed, r := 1.0 + StdErr := sqrt(1.0 / (NoPts - 3.0)); + zconf := abs(inversez(confidence / 2.0)); + if (abs(r) < 1.0) then + begin + z := samptrans / StdErr; + UCL := samptrans + (zconf * StdErr); + LCL := samptrans - (zconf * StdErr); + UCL := (exp(2.0 * UCL) - 1.0) / (exp(2.0 * UCL) + 1.0); + LCL := (exp(2.0 * LCL) - 1.0) / (exp(2.0 * LCL) + 1.0); + end + else + begin + UCL := 1.0; + LCL := 1.0; + end; + //upper[lag] := UCL; + //lower[lag] := LCL; + outline := format('%4d %9.4f %9.4f %9.4f %9.4f %9.4f %9.0f %9.4f %9.4f', + [lag, r, mx, my, sx, sy, Count, LCL, UCL]); + OutputFrm.RichEdit.Lines.Add(outline); + ncors := ncors + 1; + correlations[0,lag] := r; + correlations[lag,0] := r; + end; // next lag + OutputFrm.ShowModal; + + // build correlation matrix + for i := 0 to maxlag do correlations[i,i] := 1.0; + for i := 1 to maxlag do + begin + for j := i+1 to maxlag do + begin + correlations[i,j] := correlations[0,j-i]; + correlations[j,i] := correlations[i,j]; + end; + end; + + // Print the correlation matrix if elected + if (RmatChk.Checked = true) then + begin + OutputFrm.RichEdit.Clear; + Title := 'Matrix of Lagged Variable: '; + Title := Title + DepVarEdit.Text; + MAT_PRINT(correlations,maxlag+1,maxlag+1,Title,RowLabels,ColLabels,NoPts); + OutputFrm.ShowModal; + end; + + // Calculate partial correlations + PartCors[0] := 1.0; + for i := 1 to maxlag do // start at lag 1 + begin + for j := 1 to i do + begin + for k := 1 to i do + begin + a[j-1,k-1] := correlations[j,k]; + end; + rxy[j-1] := correlations[0,j]; + end; + SVDinverse(a, i); + + // get betas as product of inverse times vector + for j := 1 to i do + begin + betas[j-1] := 0.0; + for k := 1 to i do betas[j-1] := betas[j-1] + (a[j-1,k-1] * rxy[k-1]); + end; + + // get regression constant + // Note - since variance of Y and each X is the same, B = beta for an X + Constant := 0; + if MeanChk.Checked = false then + begin + for j := 1 to i do Constant := Constant + betas[j-1] * Mean; + Constant := Mean - Constant; + end; + + // calculate predicted value and residual + // Note - the dependent variable predicted is the next value in the + // time series using each of the previous time period values + Yhat := 0.0; + StdDevY := sqrt(covzero); + for j := 0 to i-1 do Yhat := Yhat + (betas[j] * pts[j]); + Yhat := Yhat + Constant; + avg[i] := Yhat; + residual[i] := pts[i] - Yhat; + + // print betas if elected + if (YuleWalkerChk.Checked) then + begin + OutputFrm.RichEdit.Clear; + Title := 'Yule-Walker Coefficients for lag ' + IntToStr(i); + DynVectorPrint(betas,i,Title,ColLabels,NoPts); + outline := format('Constant = %10.3f',[Constant]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + end; + + PartCors[i] := betas[i-1]; + end; // next i (lag from 1 to maxlag) + + // print partial correlations if elected + if (PartialsChk.Checked = true) then + begin + OutputFrm.RichEdit.Clear; + Title := 'Partial Correlation Coefficients'; + DynVectorPrint(PartCors,maxlag,Title,ColLabels,NoPts); + OutputFrm.ShowModal; + end; + + // plot correlations if elected + uplimit := 1.96 * (1.0 / sqrt(count)); + lowlimit := -1.96 * (1.0 / sqrt(count)); + if (PlotChk.Checked = true) then + begin + if AutoPlotFrm = nil then + Application.CreateForm(TAutoPlotFrm, AutoPlotFrm); + for i := 0 to maxlag do rxy[i] := correlations[0][i]; + AutoPlotFrm.PlotPartCors := true; + AutoPlotFrm.PlotLimits := true; + AutoPlotFrm.correlations := rxy; + AutoPlotFrm.partcors := PartCors; + AutoPlotFrm.uplimit := uplimit; + AutoPlotFrm.lowlimit := lowlimit; + AutoPlotFrm.npoints := maxlag+1; + AutoPlotFrm.DepVarEdit := DepVarEdit.Text; +// AutoPlotFrm.AutoPlot; + AutoPlotFrm.ShowModal; + end; + + if MRegSmoothChk.Checked then + begin + // calculate predicted values and residuals for remaining points + // Note - the dependent variable predicted is the next value in + // the time series using each of the previous time period values + // as predictors + for i := maxlag to (NoPts + noproj - 1) do + begin + Yhat := 0.0; + for j := 0 to maxlag do Yhat := Yhat + (betas[j] * pts[i-maxlag+j]); + Yhat := Yhat + Constant; + avg[i] := Yhat; + residual[i] := pts[i] - Yhat; + end; + // plot points smoothed by autoregression + avg[0] := pts[0]; + PointsFrm.pts := pts; + PointsFrm.avg := avg; + PointsFrm.NoCases := NoPts + noproj; + PointsFrm.LabelOne := 'Original'; + PointsFrm.LabelTwo := 'Smoothed'; + PointsFrm.Title := 'Autoregressive Smoothed'; + PointsFrm.Caption := 'Autoregression Smoothing'; + PointsFrm.ShowModal; + + // plot residuals if elected + if (ResidChk.Checked) then + begin + varresid := 0.0; + residual[0] := 0.0; + for i := 1 to maxlag do + begin +// residual[i] := pts[i] - avg[i]; + varresid := varresid + (residual[i] * residual[i]); + end; + varresid := varresid / maxlag; + StdErr := sqrt(varresid); + // plot the residuals + PointsFrm.pts := pts; + PointsFrm.avg := residual; + PointsFrm.NoCases := NoPts; + Msg := 'Std. Err. Residuals = '; + Msg := Msg + FloatToStr(StdErr); + PointsFrm.MsgEdit.Text := Msg; + PointsFrm.LabelOne := 'Original'; + PointsFrm.LabelTwo := 'Residuals'; + PointsFrm.Title := 'Residuals from Autoregression Smoothing'; + PointsFrm.Caption := 'Autoregressive Residuals'; + PointsFrm.ShowModal; + end; + end; + + // clean up the heap + residual := nil; + avg := nil; + pts := nil; + rxy := nil; + betas := nil; + a := nil; + PartCors := nil; + ColLabels := nil; + RowLabels := nil; + StdDevs := nil; + Means := nil; + correlations := nil; + ColNoSelected := nil; + + OutputFrm.RichEdit.Clear; +end; + +procedure TAutoCorrFrm.ColBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + for i := 1 to OS3MainFrm.DataGrid.ColCount - 1 do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + GroupBox2.Caption := 'Include Cases:'; + AllCasesBtn.Caption := 'All Cases'; + OnlyCasesBtn.Caption := 'Only Cases From:'; +end; + +procedure TAutoCorrFrm.InBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + DepVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + OutBtn.Enabled := true; + InBtn.Enabled := false; +end; + +procedure TAutoCorrFrm.OutBtnClick(Sender: TObject); +begin + VarList.Items.Add(DepVarEdit.Text); + DepVarEdit.Text := ''; + InBtn.Enabled := true; + OutBtn.Enabled := false; +end; + +procedure TAutoCorrFrm.four1(var data: DblDyneVec; nn: longword; isign: integer); +var + n,mmax,m,j,istep, i : longword; + wtemp,wr,wpr,wpi,wi,theta : double; + tempr,tempi : double; + +begin + n := 2 * nn; + j := 1; + i := 1; + while i < n do + begin + if (j > i) then + begin + tempr := data[j]; + tempi := data[j+1]; + data[j] := data[i]; + data[j+1] := data[i+1]; + data[i] := tempr; + data[i+1] := tempi; + end; + m := n div 2; + while (m >= 2) and (j > m) do + begin + j := j - m; + m := m div 2; + end; + j := j + m; + i := i + 2; + end; + mmax := 2; + while (n > mmax) do + begin + istep := 2 * mmax; + theta := isign * (6.28318530717959 / mmax); + wtemp := sin(0.5 * theta); + wpr := -2.0 * wtemp * wtemp; + wpi := sin(theta); + wr := 1.0; + wi := 0.0; + m := 1; + while m < mmax do + begin + i := m; + while i <= n do + begin + j := i + mmax; + tempr := wr * data[j] - wi * data[j+1]; + tempi := wr * data[j+1] + wi * data[j]; + data[j] := data[i] - tempr; + data[j+1] := data[i+1] - tempi; + data[i] := data[i] + tempr; + data[i+1] := data[i+1] + tempi; + i := i + istep; + end; + wtemp := wr; + wr := wr * wpr - wi * wpi + wr; + wi := wi * wpr + wtemp * wpi + wi; + m := m + 2; + end; + mmax := istep; + end; +end; + +procedure TAutoCorrFrm.realft(var data: DblDyneVec; n: longword; isign: integer); +var + i,i1,i2,i3,i4,np3 : longword; + c1,c2,h1r,h1i,h2r,h2i : double; + wr,wi,wpr,wpi,wtemp,theta : double; + +begin + c1 := 0.5; + theta := 3.141592653589793 / ( n div 2); + if (isign = 1) then + begin + c2 := -0.5; + four1(data,n div 2,1); + end else + begin + c2 := 0.5; + theta := -theta; + end; + wtemp := sin(0.5 * theta); + wpr := -2.0 * wtemp * wtemp; + wpi := sin(theta); + wr := 1.0 + wpr; + wi := wpi; + np3 := n + 3; + for i := 2 to n div 2 do + begin + i1 := i + i - 1; + i2 := 1 + i1; + i3 := np3 - i2; + i4 := 1 + i3; + h1r := c1 * (data[i1] + data[i3]); + h1i := c1 * (data[i2] - data[i4]); + h2r := -c2 * (data[i2] + data[i4]); + h2i := c2 * (data[i1] - data[i3]); + data[i1] := h1r + wr * h2r - wi * h2i; + data[i2] := h1i + wr * h2i + wi * h2r; + data[i3] := h1r - wr * h2r + wi * h2i; + data[i4] := -h1i + wr * h2i + wi * h2r; + wtemp := wr; + wr := wtemp * wpr - wi * wpi + wr; + wi := wi * wpr + wtemp * wpi + wi; + end; + if (isign = 1) then + begin + h1r := data[1]; + data[1] := h1r + data[2]; + data[2] := h1r - data[2]; + end else + begin + h1r := data[1]; + data[1] := c1 * (h1r + data[2]); + data[2] := c1 * (h1r - data[2]); + four1(data,n div 2,-1); + end; +end; + +procedure TAutoCorrFrm.fourier(var data: DblDyneVec; n: integer; npts: integer ); +var + nmin, m, mo2, i, k, j : integer; + yn, y1, rn1, fac, cnst : double; + y : DblDyneVec; + +begin + m := 2; + nmin := n + (2 * npts); + while (m < nmin) do m := m * 2; + cnst := npts / m; + cnst := cnst * cnst; + SetLength(y,m+1); + for i := 0 to n - 1 do y[i+1] := data[i]; + y1 := y[1]; + yn := y[n]; + rn1 := 1.0 / (n - 1); + for j := 1 to n do y[j] := y[j] + (-rn1 * (y1 * (n - j) + y1 * (j - 1))); + for j := n+1 to m do y[j] := 0.0; + mo2 := m div 2; + realft(y,mo2,1); + y[1] := y[1] / mo2; + fac := 1.0; + for j := 1 to mo2 - 1 do + begin + k := 2 * j + 1; + if (fac <> 0) then + begin + fac := (1.0 - cnst * j * j) / mo2; + if ( fac < 0.0) then fac := 0.0; + y[k] := fac * y[k]; + y[k + 1] := fac * y[k + 1]; + end + else y[k + 1] := 0.0; + y[k] := 0.0; + end; + fac := (1.0 - 0.25 * npts * npts) / mo2; + if (fac < 0.0) then fac := 0.0; + y[2] := y[2] * fac; + realft(y,mo2,-1); + for j := 1 to n do y[j] := y[j] + rn1 * (y1 * (n - j) + yn * (j - 1)); + for j := 0 to n - 1 do data[j] := y[j+1]; + y := nil; +end; + +procedure TAutoCorrFrm.PolyFit(var pts: DblDyneVec; var avg: DblDyneVec; + NoPts: integer); +var + X : DblDyneMat; + XY : DblDyneVec; + XTX : DblDyneMat; + Beta : DblDyneVec; + t, Yhat : double; + i, j, k, order : integer; + RowLabels, ColLabels : StrDyneVec; + +begin + order := StrToInt(PolynomialFrm.PolyEdit.Text); + SetLength(X,NoPts,order+1); + SetLength(XTX,order+2,order+2); + SetLength(XY,order+1); + SetLength(Beta,order+1); + SetLength(RowLabels,NoPts+1); + SetLength(ColLabels,NoPts+1); + + // initialize + for i := 0 to NoPts - 1 do + begin + for j := 0 to order do + begin + X[i,j] := 0.0; + end; + end; + for i := 0 to order do + begin + XY[i] := 0.0; + Beta[i] := 0.0; + for j := 0 to order do + begin + XTX[i,j] := 0.0; + end; + end; + + for i := 0 to NoPts - 1 do + begin + for j := 0 to order do + begin + t := i+1; + X[i,j] := Power(t,j); + end; + end; + + // print the X matrix as a check + for i := 0 to NoPts - 1 do + begin + RowLabels[i] := 'Case' + IntToStr(i+1); + end; + for i := 0 to order+1 do + begin + ColLabels[i] := 'Order' + IntToStr(i); + end; +{ + OutputFrm.RichEdit.Clear; + Title := 'X Matrix'; + DynMatPrint(X,NoPts,order+1,Title,RowLabels,ColLabels,NoPts); + OutputFrm.ShowModal; +} + // Get X transpose times X + for j := 0 to order do + begin + for k := 0 to order do + begin + XTX[j,k] := 0.0; + for i := 0 to NoPts - 1 do + begin + XTX[j,k] := XTX[j,k] + (X[i,j] * X[i,k]); + end; + end; + end; +{ + // print the XTX matrix + OutputFrm.RichEdit.Clear; + Title := 'XTX Matrix (Offset by 1)'; + DynMatPrint(XTX,order+2,order+2,Title,ColLabels,ColLabels,NoPts); + OutputFrm.ShowModal; +} + // Get X transpose Y + for j := 0 to order do + begin + for i := 0 to NoPts - 1 do + begin + XY[j] := XY[j] + (X[i,j] * pts[i]); + end; + end; +{ + // print the XY vector + OutputFrm.RichEdit.Clear; + Title := 'XY vector'; + DynVectorPrint(XY,order+1,Title,ColLabels,NoPts); + OutputFrm.ShowModal; +} + // get inverse of XTX + SVDinverse(XTX,order+1); +{ + // print the inverse matrix + OutputFrm.RichEdit.Clear; + Title := 'XTX Inverse Matrix'; + DynMatPrint(XTX,order+2,order+2,Title,ColLabels,ColLabels,NoPts); + OutputFrm.ShowModal; +} + // get betas + for j := 0 to order do + begin + for k := 0 to order do + begin + Beta[j] := Beta[j] + (XTX[j,k] * XY[k]); + end; + end; +{ + // print the betas + OutputFrm.RichEdit.Clear; + Title := 'Betas vector'; + DynVectorPrint(Beta,order+1,Title,ColLabels,NoPts); + OutputFrm.ShowModal; +} + // get predicted values + for i := 0 to NoPts - 1 do + begin + Yhat := 0.0; + t := i; + for j := 0 to order do Yhat := Yhat + (Beta[j] * Power(t,j)); + avg[i] := Yhat; + end; + + //cleanup + ColLabels := nil; + RowLabels := nil; + Beta := nil; + XY := nil; + XTX := nil; + X := nil; +end; + +initialization + {$I autocorunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/correlation/autoplotunit.lfm b/applications/lazstats/source/forms/analysis/correlation/autoplotunit.lfm new file mode 100644 index 000000000..bb3f9505c --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/autoplotunit.lfm @@ -0,0 +1,67 @@ +object AutoPlotFrm: TAutoPlotFrm + Left = 480 + Height = 517 + Top = 170 + Width = 743 + Caption = 'Autocorrelation and partial autocorrelation' + ClientHeight = 517 + ClientWidth = 743 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Image1: TImage + Left = 0 + Height = 476 + Top = 0 + Width = 743 + Align = alClient + end + object Panel1: TPanel + Left = 0 + Height = 41 + Top = 476 + Width = 743 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + ClientHeight = 41 + ClientWidth = 743 + TabOrder = 0 + object PrintBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ReturnBtn + Left = 607 + Height = 25 + Top = 8 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Print' + OnClick = PrintBtnClick + TabOrder = 0 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 670 + Height = 25 + Top = 8 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 1 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/correlation/autoplotunit.pas b/applications/lazstats/source/forms/analysis/correlation/autoplotunit.pas new file mode 100644 index 000000000..8ed44ebef --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/autoplotunit.pas @@ -0,0 +1,231 @@ +unit AutoPlotUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, Printers, + Globals; + +type + + { TAutoPlotFrm } + + TAutoPlotFrm = class(TForm) + Image1: TImage; + PrintBtn: TButton; + ReturnBtn: TButton; + Panel1: TPanel; + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure PrintBtnClick(Sender: TObject); + procedure AutoPlot(Sender: TObject); + + private + { private declarations } + + public + { public declarations } + correlations, partcors : DblDyneVec; + uplimit, lowlimit : double; + npoints : integer; + DepVarEdit : string; + PlotPartCors : boolean; // true to plot partial correlations + PlotLimits : boolean; // true to show upper and lower limits + + end; + +var + AutoPlotFrm: TAutoPlotFrm; + +implementation + +uses + Math; + +{ TAutoPlotFrm } + +procedure TAutoPlotFrm.FormShow(Sender: TObject); +begin + Image1.Canvas.Brush.Color := clWhite; + Image1.Canvas.FillRect(0, 0, Image1.Width, Image1.Height); +// AutoPlotFrm.Image1.Canvas.Clear; + AutoPlot(self); +end; + +procedure TAutoPlotFrm.PrintBtnClick(Sender: TObject); +var r : Trect; +begin + with Printer do + begin + Printer.Orientation := poPortrait; + r := Rect(20,20,printer.pagewidth-20,printer.pageheight div 2 + 20); + BeginDoc; + Canvas.StretchDraw(r,Image1.Picture.BitMap); + EndDoc; + end; +end; + +procedure TAutoPlotFrm.AutoPlot(Sender: TObject); +var + topmarg, botmarg, leftmarg, rightmarg, verthi, horizlong : integer; + i, X, Y, middle, yincrement, xincrement, labelheight : integer; + labelstring : string; + labelstr : string; + corstep, yprop, scaley : double; + +begin + height := Image1.Canvas.Height; + width := Image1.Canvas.Width; + middle := height div 2; + topmarg := height div 10; + verthi := height - (2 * topmarg); + botmarg := topmarg + verthi; + leftmarg := width div 10; + horizlong := width - 2 * leftmarg; + rightmarg := leftmarg + horizlong; + yincrement := verthi div 20; + xincrement := horizlong div npoints; + +// AutoPlotFrm.Show; + Image1.Canvas.Pen.Color := clBlack; + + // print title at top, centered + labelstring := 'Autocorrelations analysis for :'; + labelstring := labelstring + DepVarEdit; + X := (leftmarg + horizlong div 2) - (Image1.Canvas.TextWidth(labelstring) div 2); + Y := 1; + Image1.Canvas.TextOut(X,Y,labelstring); + + // draw middle (zero correlation) axis + Y := middle; + Image1.Canvas.MoveTo(leftmarg,Y); + X := rightmarg; + Image1.Canvas.LineTo(X,Y); + + // draw right axis + X := leftmarg; + Y := botmarg; + Image1.Canvas.MoveTo(X,Y); + Y := topmarg; + Image1.Canvas.LineTo(X,Y); + + // correlation scale to left of vertical axis + corstep := 1.0; + for i := 0 to 20 do + begin + Y := topmarg + (i * yincrement); + labelstr := format('%4.2f -',[corstep]); + labelstring := labelstr; + X := leftmarg - Image1.Canvas.TextWidth(labelstring); + Image1.Canvas.TextOut(X,Y,labelstring); + corstep := corstep - 0.1; + end; + + // Make legend axis on bottom + X := leftmarg; + Y := botmarg; + Image1.Canvas.MoveTo(X,Y); + X := rightmarg; + Image1.Canvas.LineTo(X,Y); + for i := 0 to npoints do + begin + X := leftmarg + (xincrement * i); + labelstring := '|'; + Image1.Canvas.TextOut(X,Y,labelstring); + labelstring := IntToStr(i); + Y := Y + 5; + if (i mod 2) = 1 then Image1.Canvas.TextOut(X,Y,labelstring); + Y := botmarg; + end; + labelstring := 'LAG VALUE'; + X := (leftmarg + horizlong div 2) - (Image1.Canvas.TextWidth(labelstring) div 2); + Y := botmarg + Image1.Canvas.TextHeight(labelstring); + Image1.Canvas.TextOut(X,Y,labelstring); + + // Plot lines from correlation to correlation + Image1.Canvas.Pen.Color := clRed; + for i := 0 to npoints - 1 do + begin + yprop := (1.0 - correlations[i]) / 2.0; + scaley := yprop * verthi; + X := leftmarg + round(xincrement * i); + Y := topmarg + round(scaley); + if (i = 0)then Image1.Canvas.MoveTo(X,Y) + else Canvas.LineTo(X,Y); + Image1.Canvas.Ellipse(X-3,Y-3,X+3,Y+3); + end; + + // Plot partial correlations + if PlotPartCors then + begin + Image1.Canvas.Pen.Color := clBlue; + for i := 0 to npoints - 1 do + begin + yprop := (1.0 - partcors[i]) / 2.0; + scaley := yprop * verthi; + X := leftmarg + round(xincrement * i); + Y := topmarg + round(scaley); + if (i = 0) then Image1.Canvas.MoveTo(X,Y) + else Image1.Canvas.LineTo(X,Y); + Image1.Canvas.Ellipse(X-3,Y-3,X+3,Y+3); + end; + end; + + // Plot lines for upper and lower 95% confidence levels + if PlotLimits then + begin + Image1.Canvas.Pen.Color := clGreen; + yprop := (1.0 - uplimit) / 2.0; + scaley := yprop * verthi; + Y := topmarg + round(scaley); + Image1.Canvas.MoveTo(leftmarg,Y); + X := rightmarg; + Image1.Canvas.LineTo(X,Y); + yprop := (1.0 - lowlimit) / 2.0; + scaley := yprop * verthi; + Y := topmarg + round(scaley); + Image1.Canvas.MoveTo(leftmarg,Y); + X := rightmarg; + Image1.Canvas.LineTo(X,Y); + end; + + // Show legend at right + X := rightmarg; + labelstring := 'Correlations'; + labelheight := Image1.Canvas.TextHeight(labelstring); + Y := 5 * labelheight; + Image1.Canvas.Font.Color := clRed; + Image1.Canvas.TextOut(X,Y,labelstring); + if PlotPartCors then + begin + labelstring := 'Partials'; + Y := 6 * labelheight; + Image1.Canvas.Font.Color := clBlue; + Image1.Canvas.TextOut(X,Y,labelstring); + end; + if PlotLimits then + begin + Y := 7 * labelheight; + labelstring := '95% C.I.'; + Image1.Canvas.Font.Color := clGreen; + Image1.Canvas.TextOut(X,Y,labelstring); + end; +end; + +procedure TAutoPlotFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([PrintBtn.Width, ReturnBtn.Width]); + PrintBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +initialization + {$I autoplotunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/correlation/canonunit.lfm b/applications/lazstats/source/forms/analysis/correlation/canonunit.lfm new file mode 100644 index 000000000..b9779a6ae --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/canonunit.lfm @@ -0,0 +1,484 @@ +object CannonFrm: TCannonFrm + Left = 261 + Height = 379 + Top = 157 + Width = 401 + AutoSize = True + Caption = 'Canonical Correlation Analysis' + ClientHeight = 379 + ClientWidth = 401 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 72 + Top = 258 + Width = 225 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 16 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 52 + ClientWidth = 221 + TabOrder = 1 + object CorsChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 87 + Caption = 'Correlations' + TabOrder = 0 + end + object InvChk: TCheckBox + Left = 115 + Height = 19 + Top = 6 + Width = 94 + Caption = 'Matrix Inverse' + TabOrder = 1 + end + object EigenChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 87 + Caption = 'Eigenvectors' + TabOrder = 2 + end + object RedundChk: TCheckBox + Left = 115 + Height = 19 + Top = 27 + Width = 94 + Caption = 'Redundancies' + TabOrder = 3 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 104 + Height = 25 + Top = 346 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 170 + Height = 25 + Top = 346 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 4 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 244 + Height = 25 + Top = 346 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 332 + Height = 25 + Top = 346 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 6 + end + object HelpBtn: TButton + Tag = 111 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 41 + Height = 25 + Top = 346 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 2 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 330 + Width = 401 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 0 + Height = 258 + Top = 0 + Width = 401 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BevelOuter = bvNone + ClientHeight = 258 + ClientWidth = 401 + TabOrder = 0 + object Label1: TLabel + AnchorSideTop.Control = Panel1 + Left = 8 + Height = 15 + Top = 8 + Width = 100 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = LeftList + Left = 222 + Height = 15 + Top = 8 + Width = 103 + BorderSpacing.Top = 8 + Caption = 'Left-Hand Variables' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = RightList + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrCenter + Left = 222 + Height = 15 + Top = 130 + Width = 111 + Caption = 'Right-Hand Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = LeftIn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 225 + Top = 25 + Width = 170 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object LeftIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 186 + Height = 28 + Top = 25 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = LeftInClick + Spacing = 0 + TabOrder = 1 + end + object LeftOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = LeftIn + AnchorSideTop.Side = asrBottom + Left = 186 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = LeftOutClick + Spacing = 0 + TabOrder = 2 + end + object RightIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = RightOut + Left = 186 + Height = 28 + Top = 190 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = RightInClick + Spacing = 0 + TabOrder = 4 + end + object RightOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 186 + Height = 28 + Top = 222 + Width = 28 + Anchors = [akLeft, akBottom] + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = RightOutClick + Spacing = 0 + TabOrder = 5 + end + object LeftList: TListBox + AnchorSideLeft.Control = LeftIn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Label3 + Left = 222 + Height = 89 + Top = 25 + Width = 171 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 16 + ItemHeight = 0 + TabOrder = 3 + end + object RightList: TListBox + AnchorSideLeft.Control = LeftList + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = LeftList + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 222 + Height = 103 + Top = 147 + Width = 171 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + ItemHeight = 0 + TabOrder = 6 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/correlation/canonunit.pas b/applications/lazstats/source/forms/analysis/correlation/canonunit.pas new file mode 100644 index 000000000..b7f96cab2 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/canonunit.pas @@ -0,0 +1,621 @@ +unit CanonUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, GraphLib, Globals, MatrixLib, + ContextHelpUnit; + +type + + { TCannonFrm } + + TCannonFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + CorsChk: TCheckBox; + InvChk: TCheckBox; + EigenChk: TCheckBox; + RedundChk: TCheckBox; + GroupBox1: TGroupBox; + LeftIn: TBitBtn; + LeftOut: TBitBtn; + RightIn: TBitBtn; + RightOut: TBitBtn; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + LeftList: TListBox; + RightList: TListBox; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure LeftInClick(Sender: TObject); + procedure LeftOutClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure RightInClick(Sender: TObject); + procedure RightOutClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + CannonFrm: TCannonFrm; + +implementation + +uses + Math; + +{ TCannonFrm } + +procedure TCannonFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + LeftList.Clear; + RightList.Clear; + LeftOut.Enabled := false; + LeftIn.Enabled := true; + RightOut.Enabled := false; + RightIn.Enabled := true; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TCannonFrm.RightInClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + RightList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + RightOut.Enabled := true; +end; + +procedure TCannonFrm.RightOutClick(Sender: TObject); +VAR index : integer; +begin + index := RightList.ItemIndex; + if index < 0 then + begin + RightOut.Enabled := false; + exit; + end; + VarList.Items.Add(RightList.Items.Strings[index]); + RightList.Items.Delete(index); +end; + +procedure TCannonFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TCannonFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TCannonFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TCannonFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TCannonFrm.ComputeBtnClick(Sender: TObject); +label cleanup; +var + i, j, k, count, a_size, b_size, no_factors, novars, IER: integer; + outline, cellstring, gridstring: string; + s, m, n, df1, df2, q, w, pcnt_extracted, trace : double; + minroot, critical_prob, Lambda, Pillia : double; + chisqr, HLTrace, chiprob, ftestprob, Roys, f, Hroot : double; + raa, rbb, rab, rba, bigmat, prod, first_prod, second_prod : DblDyneMat; + char_equation, raainv, rbbinv, eigenvectors, norm_a, norm_b : DblDyneMat; + raw_a, raw_b, a_cors, b_cors, eigentrans, theta, tempmat : DblDyneMat; + mean, variance, stddev, roots, root_chi, chi_prob, pv_a, pv_b : DblDyneVec; + rd_a, rd_b, pcnt_trace : DblDyneVec; + root_df, a_vars, b_vars : IntDyneVec; + selected : IntDyneVec; + RowLabels, ColLabels : StrDyneVec; + CanLabels : StrDyneVec; + NCases : integer; + title : string; + errorcode : boolean = false; + +begin + k := 0; + no_factors := 0; + pcnt_extracted := 0.0; + trace := 0.0; + minroot := 0.0; + critical_prob := 0.0; + Pillia := 0.0; + chisqr := 0.0; + HLTrace := 0.0; + chiprob := 0.0; + + // Get size of the Left and Right matrices (predictors and dependents) + a_size := LeftList.Items.Count; + b_size := RightList.Items.Count; + novars := a_size + b_size; + + // allocate memory for matrices and vectors + SetLength(raa,a_size,a_size); + SetLength(rbb,b_size,b_size); + SetLength(rab,a_size,b_size); + SetLength(rba,b_size,a_size); + SetLength(bigmat,novars+1,novars+1); + SetLength(prod,novars,novars); + SetLength(first_prod,novars,novars); + SetLength(second_prod,novars,novars); + SetLength(char_equation,novars,novars); + SetLength(raainv,a_size,a_size); + SetLength(rbbinv,b_size,b_size); + SetLength(eigenvectors,novars,novars); + SetLength(norm_a,novars,novars); + SetLength(norm_b,novars,novars); + SetLength(raw_a,novars,novars); + SetLength(raw_b,novars,novars); + SetLength(a_cors,novars,novars); + SetLength(b_cors,novars,novars); + SetLength(eigentrans,novars,novars); + SetLength(theta,novars,novars); + SetLength(tempmat,novars,novars); + + SetLength(mean,novars); + SetLength(variance,novars); + SetLength(stddev,novars); + SetLength(roots,novars); + SetLength(root_chi,novars); + SetLength(chi_prob,novars); + SetLength(pv_a,novars); + SetLength(pv_b,novars); + SetLength(rd_a,novars); + SetLength(rd_b,novars); + SetLength(pcnt_trace,novars); + + SetLength(root_df,novars); + SetLength(a_vars,a_size); + SetLength(b_vars,b_size); + SetLength(CanLabels,novars); + SetLength(RowLabels,novars); + SetLength(ColLabels,novars); + SetLength(Selected,novars); + + //------------ WORK STARTS HERE! ------------------------------------- + + // Build labels for canonical functions 1 to novars + for i := 1 to b_size do + CanLabels[i-1]:='Var. ' + IntToStr(i); + + // identify variables selected for left and right variables + for i := 0 to a_size - 1 do // identify left variables + begin + cellstring := LeftList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + gridstring := OS3MainFrm.DataGrid.Cells[j,0]; + if (cellstring = gridstring) then + begin + a_vars[i] := j; + RowLabels[i] := gridstring; + end; + end; + end; + for i := 0 to b_size - 1 do // identify left variables + begin + cellstring := RightList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + gridstring := OS3MainFrm.DataGrid.Cells[j,0]; + if (cellstring = gridstring) then + begin + b_vars[i] := j; + ColLabels[i] := gridstring; + end; + end; + end; + + // build list of all variables selected + for i := 1 to a_size do selected[i-1] := a_vars[i-1]; + for i := 1 to b_size do selected[i-1 + a_size] := b_vars[i-1]; + + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('CANONICAL CORRELATION ANALYSIS'); + OutputFrm.RichEdit.Lines.Add(''); + // Get means, standard deviations, etc. for total matrix + Correlations(novars,selected,bigmat,mean,variance,stddev,errorcode,Ncases); + count := Ncases; + if (IER = 1)then + begin + ShowMessage('Zero variance found for a variable-terminating'); + goto cleanup; + end; + + //partition matrix into quadrants + for i := 1 to a_size do + for j := 1 to a_size do raa[i-1,j-1]:= bigmat[i-1,j-1]; + + for i := a_size + 1 to novars do + for j := a_size + 1 to novars do + rbb[i-1-a_size,j-1-a_size] := bigmat[i-1,j-1]; + + for i := 1 to a_size do + for j := a_size + 1 to novars do + rab[i-1,j-1-a_size] := bigmat[i-1,j-1]; + + for i := a_size + 1 to novars do + for j := 1 to a_size do + rba[i-1-a_size,j-1] := bigmat[i-1,j-1]; + + if CorsChk.Checked then + begin + title := 'Left Correlation Matrix'; + MAT_PRINT(raa,a_size,a_size,title,RowLabels,RowLabels,NCases); + title := 'Right Correlation Matrix'; + MAT_PRINT(rbb,b_size,b_size,title,ColLabels,ColLabels,NCases); + title := 'Left-Right Correlation Matrix'; + MAT_PRINT(rab,a_size,b_size,title,RowLabels,ColLabels,NCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + // get inverses of left and right hand matrices raa and rbb + for i := 1 to a_size do + for j := 1 to a_size do + raainv[i-1,j-1] := raa[i-1,j-1]; + SVDinverse(raainv,a_size); + if InvChk.Checked then + begin + title := 'Inverse of Left Matrix'; + MAT_PRINT(raainv,a_size,a_size,title,RowLabels,RowLabels,NCases); + end; + + for i := 1 to b_size do + for j := 1 to b_size do + rbbinv[i-1,j-1] := rbb[i-1,j-1]; + SVDinverse(rbbinv,b_size); + if InvChk.Checked then + begin + title := 'Inverse of Right Matrix'; + MAT_PRINT(rbbinv,b_size,b_size,title,ColLabels,ColLabels,NCases); + end; + + // get products of raainv x rab and the rbbinv x rba matrix + MatAxB(first_prod,rbbinv,rba,b_size,b_size,b_size,a_size,errorcode); + MatAxB(second_prod,raainv,rab,a_size,a_size,a_size,b_size,errorcode); + title := 'Right Inverse x Right-Left Matrix'; + MAT_PRINT(first_prod,b_size,a_size,title,ColLabels,RowLabels,NCases); + title := 'Left Inverse x Left-Right Matrix'; + MAT_PRINT(second_prod,a_size,b_size,title,RowLabels,ColLabels,NCases); + + //get characteristic equations matrix (product of last two product matrices + //The product should yeild rows and cols representing the smaller of the two sets + MatAxB(char_equation,first_prod,second_prod,b_size,a_size, a_size,b_size,errorcode); + title := 'Canonical Function'; + MAT_PRINT(char_equation,b_size,b_size,title,CanLabels,CanLabels,NCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // now get roots and vectors of the characteristic equation using + // NonSymRoots routine + minroot := 0.0; + for i := 1 to b_size do + begin + roots[i-1] := 0.0; + pcnt_trace[i-1] := 0.0; + for j := 1 to b_size do eigenvectors[i-1,j-1] := 0.0; + end; + trace := 0.0; + no_factors := b_size; + nonsymroots(char_equation, b_size, no_factors, minroot, eigenvectors, roots, + pcnt_trace, trace, pcnt_extracted); + outline := format('Trace of the matrix:=%10.4f',[trace]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Percent of trace extracted: %10.4f',[pcnt_extracted]); + OutputFrm.RichEdit.Lines.Add(outline); + + // Normalize smaller set weights and coumpute larger set weights + MATTRN(eigentrans,eigenvectors,b_size,b_size); + MatAxB(tempmat,eigentrans,rbb,b_size,b_size,b_size,b_size,errorcode); + MatAxB(theta,tempmat,eigenvectors,b_size,b_size,b_size,b_size,errorcode); + for j := 1 to b_size do + begin + q := 1.0 / sqrt(theta[j-1,j-1]); + for i := 1 to b_size do + begin + norm_b[i-1,j-1] := eigenvectors[i-1,j-1] * q; + raw_b[i-1,j-1] := norm_b[i-1,j-1] / stddev[a_size+i-1]; + end; + end; + MatAxB(norm_a,second_prod,norm_b,a_size,b_size,b_size,b_size,errorcode); + for j := 1 to b_size do + begin + for i := 1 to a_size do + begin + norm_a[i-1,j-1] := norm_a[i-1,j-1] * (1.0 / sqrt(roots[j-1])); + raw_a[i-1,j-1] := norm_a[i-1,j-1] / stddev[i-1]; + end; + end; + + // Compute the correlations between variables and canonical variables + MatAxB(a_cors,raa,norm_a,a_size,a_size,a_size,b_size,errorcode); + for j := 1 to b_size do + begin + q := 0.0; + for i := 1 to a_size do q := q + norm_a[i-1,j-1] * a_cors[i-1,j-1]; + q := 1.0 / sqrt(q); + for i := 1 to a_size do a_cors[i-1,j-1] := a_cors[i-1,j-1] * q; + end; + MatAxB(b_cors,rbb,norm_b,b_size,b_size,b_size,b_size,errorcode); + for j := 1 to b_size do + begin + q := 0.0; + for i := 1 to b_size do q := q + norm_b[i-1,j-1] * b_cors[i-1,j-1]; + q := 1.0 / sqrt(q); + for i := 1 to b_size do b_cors[i-1,j-1] := b_cors[i-1,j-1] * q; + end; + + // Compute the Proportions of Variance (PVs) and Redundancy Coefficients + for j := 1 to b_size do + begin + pv_a[j-1] := 0.0; + for i := 1 to a_size do pv_a[j-1] := pv_a[j-1] + (a_cors[i-1,j-1] * a_cors[i-1,j-1]); + pv_a[j-1] := pv_a[j-1] / a_size; + rd_a[j-1] := pv_a[j-1] * roots[j-1]; + end; + for j := 1 to b_size do + begin + pv_b[j-1] := 0.0; + for i := 1 to b_size do pv_b[j-1] := pv_b[j-1] + (b_cors[i-1,j-1] * b_cors[i-1,j-1]); + pv_b[j-1] := pv_b[j-1] / b_size; + rd_b[j-1] := pv_b[j-1] * roots[j-1]; + end; + + // Compute tests of the roots + q := a_size + b_size + 1; + q := -(count - 1.0 - (q / 2.0)); + k := 0; + for i := 1 to b_size do + begin + w := 1.0; + for j := i to b_size do w := w * (1.0 - roots[j-1]); + root_chi[i-1] := q * ln(w); + root_df[i-1] := (a_size - i + 1) * (b_size - i + 1); + chi_prob[i-1] := 1.0 - chisquaredprob(root_chi[i-1],root_df[i-1]); + if (chi_prob[i-1] < critical_prob) then k := k + 1; + end; + Roys := roots[0] / (1.0 - roots[0]); + Lambda := 1.0; + for i := 1 to b_size do + begin + Hroot := roots[i-1] / (1.0 - roots[i-1]); + Lambda := Lambda * (1.0 / (1.0 + Hroot)); + Pillia := Pillia + (Hroot / (1.0 + Hroot)); + HLTrace := HLTrace + Hroot; + end; + + // Print remaining results + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add(''); + outline := ' Canonical R Root % Trace Chi-Sqr D.F. Prob.'; + OutputFrm.RichEdit.Lines.Add(outline); + for i := 1 to b_size do + begin + outline := format('%2d %10.6f %8.3f %7.3f %8.3f %2d %8.3f', + [i, sqrt(roots[i-1]), roots[i-1], pcnt_trace[i-1], root_chi[i-1], root_df[i-1], chi_prob[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + chisqr := -ln(Lambda) * (count - 1.0 - 0.5 * (a_size + b_size - 1.0)); + chiprob := 1.0 - chisquaredprob(chisqr,a_size * b_size); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Overall Tests of Significance:'); + OutputFrm.RichEdit.Lines.Add(' Statistic Approx. Stat. Value D.F. Prob.>Value'); + outline := format('Wilk''s Lambda Chi-Squared %10.4f %3d %6.4f', + [chisqr,a_size * b_size,chiprob]); + OutputFrm.RichEdit.Lines.Add(outline); + s := b_size; + m := 0.5 * (a_size - b_size - 1); + n := 0.5 * (count - b_size - a_size - 2); + f := (HLTrace * 2.0 * (s * n + 1)) / (s * s * (2.0 * m + s + 1.0)); + df1 := s * (2.0 * m + s + 1.0); + df2 := 2.0 * ( s * n + 1.0); + ftestprob := probf(f,df1,df2); + outline := format('Hotelling-Lawley Trace F-Test %10.4f %2.0f %2.0f %6.4f', + [f, df1,df2, ftestprob]); + OutputFrm.RichEdit.Lines.Add(outline); + df2 := s * (2.0 * n + s + 1.0); + f := (Pillia / (s - Pillia)) * ( (2.0 * n + s +1.0) / (2.0 * m + s + 1.0) ); + ftestprob := probf(f,df1,df2); + outline := format('Pillai Trace F-Test %10.4f %2.0f %2.0f %6.4f', + [f, df1,df2, ftestprob]); + OutputFrm.RichEdit.Lines.Add(outline); + Roys := Roys * (count - 1 - a_size + b_size)/ a_size ; + df1 := a_size; + df2 := count - 1 - a_size + b_size; + ftestprob := probf(Roys,df1,df2); + outline := format('Roys Largest Root F-Test %10.4f %2.0f %2.0f %6.4f', + [Roys, df1, df2, ftestprob]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + if EigenChk.Checked then + begin + title := 'Eigenvectors'; + MAT_PRINT(eigenvectors,b_size,b_size,title,CanLabels,CanLabels,NCases); + OutputFrm.ShowModal(); + OutputFrm.RichEdit.Clear; + end; + + title := 'Standardized Right Side Weights'; + MAT_PRINT(norm_a,a_size,b_size,title,RowLabels,CanLabels,NCases); + title := 'Standardized Left Side Weights'; + MAT_PRINT(norm_b,b_size,b_size,title,ColLabels,CanLabels,NCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + title := 'Raw Right Side Weights'; + MAT_PRINT(raw_a,a_size,b_size,title,RowLabels,CanLabels,NCases); + title := 'Raw Left Side Weights'; + MAT_PRINT(raw_b,b_size,b_size,title,ColLabels,CanLabels,NCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + title := 'Right Side Correlations with Function'; + MAT_PRINT(a_cors,a_size,b_size,title,RowLabels,CanLabels,NCases); + title := 'Left Side Correlations with Function'; + MAT_PRINT(b_cors,b_size,b_size,title,ColLabels,CanLabels,NCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + if RedundChk.Checked then + begin + outline := 'Redundancy Analysis for Right Side Variables'; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := ' Variance Prop. Redundancy'; + OutputFrm.RichEdit.Lines.Add(outline); + for i := 1 to b_size do + begin + outline := format('%10d %10.5f %10.5f',[i,pv_a[i-1],rd_a[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + outline := 'Redundancy Analysis for Left Side Variables'; + OutputFrm.RichEdit.Lines.Add(outline); + outline := ' Variance Prop. Redundancy'; + OutputFrm.RichEdit.Lines.Add(outline); + for i := 1 to b_size do + begin + outline := format('%10d %10.5f %10.5f',[i,pv_b[i-1],rd_b[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + //------------- Now, clean up memory mess ---------------------------- +cleanup: + Selected := nil; + ColLabels := nil; + RowLabels := nil; + CanLabels := nil; + b_vars := nil; + a_vars := nil; + root_df := nil; + pcnt_trace := nil; + rd_b := nil; + rd_a := nil; + pv_b := nil; + pv_a := nil; + chi_prob := nil; + root_chi := nil; + roots := nil; + stddev := nil; + variance := nil; + mean := nil; + tempmat := nil; + theta := nil; + eigentrans := nil; + b_cors := nil; + a_cors := nil; + raw_b := nil; + raw_a := nil; + norm_b := nil; + norm_a := nil; + eigenvectors := nil; + rbbinv := nil; + raainv := nil; + char_equation := nil; + second_prod := nil; + first_prod := nil; + prod := nil; + rba := nil; + rab := nil; + rbb := nil; + raa := nil; +end; + +procedure TCannonFrm.LeftInClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + LeftList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + LeftOut.Enabled := true; +end; + +procedure TCannonFrm.LeftOutClick(Sender: TObject); +VAR index : integer; +begin + index := LeftList.ItemIndex; + if index < 0 then + begin + LeftOut.Enabled := false; + exit; + end; + VarList.Items.Add(LeftList.Items.Strings[index]); + LeftList.Items.Delete(index); +end; + +initialization + {$I canonunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/correlation/differenceunit.lfm b/applications/lazstats/source/forms/analysis/correlation/differenceunit.lfm new file mode 100644 index 000000000..04036971a --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/differenceunit.lfm @@ -0,0 +1,153 @@ +object DifferenceFrm: TDifferenceFrm + Left = 611 + Height = 115 + Top = 292 + Width = 318 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Differencing Specification' + ClientHeight = 115 + ClientWidth = 318 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CancelBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + Left = 128 + Height = 25 + Top = 78 + Width = 62 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object OKBtn: TButton + AnchorSideLeft.Control = CancelBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + Left = 202 + Height = 25 + Top = 78 + Width = 42 + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 + BorderSpacing.Bottom = 8 + Caption = 'OK' + ModalResult = 1 + TabOrder = 3 + end + object HelpBtn: TButton + Tag = 121 + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CancelBtn + Left = 65 + Height = 25 + Top = 78 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 1 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 68 + Height = 50 + Top = 8 + Width = 183 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BevelOuter = bvNone + ClientHeight = 50 + ClientWidth = 183 + TabOrder = 0 + object Label1: TLabel + AnchorSideTop.Control = LagEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LagEdit + Left = 13 + Height = 15 + Top = 4 + Width = 108 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Difference for lag of:' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = OrderEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = OrderEdit + Left = 0 + Height = 15 + Top = 31 + Width = 121 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'No. of times to repeat: ' + ParentColor = False + end + object LagEdit: TEdit + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 129 + Height = 23 + Top = 0 + Width = 54 + Alignment = taRightJustify + Anchors = [akTop, akRight] + TabOrder = 0 + Text = '1' + end + object OrderEdit: TEdit + AnchorSideTop.Control = LagEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 129 + Height = 23 + Top = 27 + Width = 54 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + TabOrder = 1 + Text = '1' + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 62 + Width = 318 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/correlation/differenceunit.pas b/applications/lazstats/source/forms/analysis/correlation/differenceunit.pas new file mode 100644 index 000000000..2e59ff757 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/differenceunit.pas @@ -0,0 +1,71 @@ +unit DifferenceUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, contexthelpunit; + +type + + { TDifferenceFrm } + + TDifferenceFrm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + HelpBtn: TButton; + OKBtn: TButton; + LagEdit: TEdit; + OrderEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Panel1: TPanel; + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + DifferenceFrm: TDifferenceFrm; + +implementation + +uses + Math; + +{ TDifferenceFrm } + +procedure TDifferenceFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([HelpBtn.Width, CancelBtn.Width, OKBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + OKBtn.Constraints.MinWidth := w; +end; + +procedure TDifferenceFrm.FormShow(Sender: TObject); +begin + LagEdit.Text := '1'; + OrderEdit.Text := '1'; +end; + +procedure TDifferenceFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +initialization + {$I differenceunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/correlation/expsmoothunit.lfm b/applications/lazstats/source/forms/analysis/correlation/expsmoothunit.lfm new file mode 100644 index 000000000..89ce225dc --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/expsmoothunit.lfm @@ -0,0 +1,137 @@ +object ExpSmoothFrm: TExpSmoothFrm + Left = 659 + Height = 131 + Top = 369 + Width = 352 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Exponential Smoothing Form' + ClientHeight = 131 + ClientWidth = 352 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideTop.Control = AlphaEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = AlphaEdit + Left = 101 + Height = 15 + Top = 12 + Width = 45 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Alpha = ' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = AlphaScroll + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 66 + Width = 15 + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + Caption = '0.0' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = AlphaScroll + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 329 + Height = 15 + Top = 66 + Width = 15 + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + Caption = '1.0' + ParentColor = False + end + object AlphaEdit: TEdit + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 154 + Height = 23 + Top = 8 + Width = 44 + Alignment = taRightJustify + BorderSpacing.Top = 8 + TabOrder = 0 + Text = '0.99' + end + object AlphaScroll: TScrollBar + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = AlphaEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 23 + Top = 39 + Width = 336 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Max = 1 + PageSize = 0 + Position = 1 + TabOrder = 1 + OnChange = AlphaScrollChange + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = OKBtn + Left = 228 + Height = 25 + Top = 97 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object OKBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 302 + Height = 25 + Top = 97 + Width = 42 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'OK' + ModalResult = 1 + TabOrder = 3 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 81 + Width = 352 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/correlation/expsmoothunit.pas b/applications/lazstats/source/forms/analysis/correlation/expsmoothunit.pas new file mode 100644 index 000000000..16d4eef05 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/expsmoothunit.pas @@ -0,0 +1,68 @@ +unit ExpSmoothUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls; + +type + + { TExpSmoothFrm } + + TExpSmoothFrm = class(TForm) + AlphaEdit: TEdit; + Bevel1: TBevel; + CancelBtn: TButton; + OKBtn: TButton; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + AlphaScroll: TScrollBar; + procedure AlphaScrollChange(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + private + { private declarations } + public + { public declarations } + alpha : double; + end; + +var + ExpSmoothFrm: TExpSmoothFrm; + +implementation + +uses + Math; + +{ TExpSmoothFrm } + +procedure TExpSmoothFrm.FormActivate(Sender: TObject); +begin + OKBtn.Constraints.MinWidth := MaxValue([OKBtn.Width, CancelBtn.Width]); + CancelBtn.Constraints.MinWidth := OKBtn.Constraints.MinWidth; +end; + +procedure TExpSmoothFrm.FormShow(Sender: TObject); +begin + AlphaEdit.Text := '0.99'; + AlphaScroll.Position := 99; + alpha := 0.99; +end; + +procedure TExpSmoothFrm.AlphaScrollChange(Sender: TObject); +begin + AlphaEdit.Text := FloatToStr(AlphaScroll.Position / 100.0); + alpha := AlphaScroll.Position / 100.0; +end; + + +initialization + {$I expsmoothunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/correlation/fftunit.lfm b/applications/lazstats/source/forms/analysis/correlation/fftunit.lfm new file mode 100644 index 000000000..2f15ef442 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/fftunit.lfm @@ -0,0 +1,122 @@ +object FFTFrm: TFFTFrm + Left = 648 + Height = 127 + Top = 346 + Width = 305 + BorderStyle = bsDialog + Caption = 'Fourier Transform Form' + ClientHeight = 127 + ClientWidth = 305 + OnActivate = FormActivate + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = OKBtn + Left = 177 + Height = 25 + Top = 93 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + object OKBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 251 + Height = 25 + Top = 93 + Width = 42 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'OK' + ModalResult = 1 + TabOrder = 2 + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 30 + Top = 8 + Width = 289 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Enter the number of data points to include in the Fourier smoothing.' + ParentColor = False + WordWrap = True + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 66 + Height = 23 + Top = 50 + Width = 172 + AutoSize = True + BorderSpacing.Left = 64 + BorderSpacing.Top = 12 + BorderSpacing.Right = 64 + BorderSpacing.Bottom = 4 + BevelOuter = bvNone + ClientHeight = 23 + ClientWidth = 172 + TabOrder = 0 + object Label1: TLabel + AnchorSideTop.Control = NptsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NptsEdit + Left = 0 + Height = 15 + Top = 4 + Width = 100 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Number of points: ' + ParentColor = False + end + object NptsEdit: TEdit + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 108 + Height = 23 + Top = 0 + Width = 64 + Alignment = taRightJustify + Anchors = [akTop, akRight] + TabOrder = 0 + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 77 + Width = 305 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/correlation/fftunit.pas b/applications/lazstats/source/forms/analysis/correlation/fftunit.pas new file mode 100644 index 000000000..257731a3a --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/fftunit.pas @@ -0,0 +1,53 @@ +unit FFTUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls; + +type + + { TFFTFrm } + + TFFTFrm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + Memo1: TLabel; + OKBtn: TButton; + NptsEdit: TEdit; + Label1: TLabel; + Panel1: TPanel; + procedure FormActivate(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + FFTFrm: TFFTFrm; + +implementation + +uses + Math; + +{ TFFTFrm } + +procedure TFFTFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([CancelBtn.Width, OKBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + OKBtn.Constraints.MinWidth := w; +end; + +initialization + {$I fftunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/correlation/moveavgunit.lfm b/applications/lazstats/source/forms/analysis/correlation/moveavgunit.lfm new file mode 100644 index 000000000..08795a0d7 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/moveavgunit.lfm @@ -0,0 +1,154 @@ +object MoveAvgFrm: TMoveAvgFrm + Left = 434 + Height = 307 + Top = 163 + Width = 372 + Caption = 'Moving Average Specification Form' + ClientHeight = 307 + ClientWidth = 372 + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideTop.Control = OrderEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = OrderEdit + Left = 38 + Height = 15 + Top = 17 + Width = 36 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Order: ' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ThetaEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 52 + Width = 66 + BorderSpacing.Left = 8 + Caption = 'Theta Value: ' + ParentColor = False + end + object OrderEdit: TEdit + AnchorSideLeft.Control = ThetaEdit + AnchorSideRight.Control = ThetaList + AnchorSideRight.Side = asrBottom + Left = 82 + Height = 23 + Top = 13 + Width = 118 + Alignment = taRightJustify + OnKeyPress = OrderEditKeyPress + TabOrder = 0 + Text = 'OrderEdit' + end + object ThetaEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = ThetaList + AnchorSideRight.Side = asrBottom + Left = 82 + Height = 23 + Top = 48 + Width = 118 + Alignment = taRightJustify + BorderSpacing.Left = 8 + OnKeyPress = ThetaEditKeyPress + TabOrder = 1 + Text = 'ThetaEdit' + end + object ThetaList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Panel1 + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 219 + Top = 80 + Width = 286 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + OnClick = ThetaListClick + TabOrder = 2 + end + object Panel1: TPanel + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 302 + Height = 157 + Top = 142 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ChildSizing.VerticalSpacing = 8 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 157 + ClientWidth = 62 + TabOrder = 3 + object HelpBtn: TButton + Tag = 132 + Left = 0 + Height = 25 + Top = 0 + Width = 62 + AutoSize = True + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 0 + end + object ResetBtn: TButton + Left = 0 + Height = 25 + Top = 33 + Width = 62 + AutoSize = True + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object CancelBtn: TButton + Left = 0 + Height = 25 + Top = 66 + Width = 62 + AutoSize = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object ApplyBtn: TButton + Left = 0 + Height = 25 + Top = 99 + Width = 62 + AutoSize = True + Caption = 'Apply' + OnClick = ApplyBtnClick + TabOrder = 3 + end + object OKBtn: TButton + Left = 0 + Height = 25 + Top = 132 + Width = 62 + AutoSize = True + Caption = 'OK' + ModalResult = 1 + TabOrder = 4 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/correlation/moveavgunit.pas b/applications/lazstats/source/forms/analysis/correlation/moveavgunit.pas new file mode 100644 index 000000000..19cfa75df --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/moveavgunit.pas @@ -0,0 +1,133 @@ +unit MoveAvgUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + ContextHelpUnit; + +type + + { TMoveAvgFrm } + + TMoveAvgFrm = class(TForm) + HelpBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ApplyBtn: TButton; + OKBtn: TButton; + ThetaList: TListBox; + ThetaEdit: TEdit; + Label2: TLabel; + OrderEdit: TEdit; + Label1: TLabel; + procedure ApplyBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure OrderEditKeyPress(Sender: TObject; var Key: char); + procedure ResetBtnClick(Sender: TObject); + procedure ThetaEditKeyPress(Sender: TObject; var Key: char); + procedure ThetaListClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + W : array[0..20] of double; + order : integer; + currentindex : integer; + + end; + +var + MoveAvgFrm: TMoveAvgFrm; + +implementation + +{ TMoveAvgFrm } + +procedure TMoveAvgFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + OrderEdit.Text := ''; + ThetaEdit.Text := ''; + ThetaList.Clear; + currentindex := 0; + for i := 0 to 20 do W[i] := 1.0; +end; + +procedure TMoveAvgFrm.ThetaEditKeyPress(Sender: TObject; var Key: char); +var cellstring : string; + +begin + if currentindex < 1 then exit; + if ord(Key) <> 13 then exit; + cellstring := 'Theta(' + IntToStr(currentindex + 1) + ') = '; + cellstring := cellstring + ThetaEdit.Text; + W[currentindex + 1] := StrToFloat(ThetaEdit.Text); +end; + +procedure TMoveAvgFrm.ThetaListClick(Sender: TObject); +VAR index : integer; +begin + index := ThetaList.ItemIndex; + if index < 0 then exit; + currentindex := index; + ThetaEdit.Text := '1.0'; + ThetaEdit.SetFocus; +end; + +procedure TMoveAvgFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TMoveAvgFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TMoveAvgFrm.ApplyBtnClick(Sender: TObject); +var + sum : double; + i : integer; + cellstring : string; + +begin + ThetaList.Clear; + sum := W[0]; + for i := 1 to order do sum := sum + (2.0 * W[i]); + for i := 0 to order do + begin + W[i] := W[i] / sum; + cellstring := 'Theta(' + IntToStr(i+1) + ') = '; + cellstring := cellstring + FloatToStr(W[i]); + ThetaList.Items.Add(cellstring); + end; +end; + +procedure TMoveAvgFrm.OrderEditKeyPress(Sender: TObject; var Key: char); +VAR cellstring : string; + i : integer; + +begin + if ord(Key) <> 13 then exit; + ThetaList.Clear; + order := StrToInt(OrderEdit.Text); + for i := 1 to order do + begin + cellstring := 'Theta(' + IntToStr(i) + ')'; + ThetaList.Items.Add(cellstring); + end; +end; + +initialization + {$I moveavgunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/correlation/partialsunit.lfm b/applications/lazstats/source/forms/analysis/correlation/partialsunit.lfm new file mode 100644 index 000000000..2579dcae7 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/partialsunit.lfm @@ -0,0 +1,559 @@ +object PartialsFrm: TPartialsFrm + Left = 637 + Height = 460 + Top = 307 + Width = 412 + AutoSize = True + Caption = 'Partial Correlation' + ClientHeight = 460 + ClientWidth = 412 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 100 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = DepVar + AnchorSideTop.Control = DepInBtn + AnchorSideBottom.Control = DepVar + Left = 228 + Height = 15 + Top = 25 + Width = 152 + Caption = 'Selected Dependent Variable:' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = PredList + Left = 229 + Height = 15 + Top = 120 + Width = 144 + Caption = 'Selected Predictor Variables' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = PartList + AnchorSideTop.Control = PartInBtn + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 289 + Width = 121 + BorderSpacing.Top = 8 + Caption = 'Variables Partialed Out:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepInBtn + Left = 8 + Height = 220 + Top = 25 + Width = 176 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 220 + Constraints.MinWidth = 175 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object DepInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 192 + Height = 28 + Top = 25 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInBtnClick + Spacing = 0 + TabOrder = 1 + end + object DepOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepInBtn + AnchorSideTop.Side = asrBottom + Left = 192 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object PredInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = PredOutBtn + Left = 192 + Height = 28 + Top = 185 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = PredInBtnClick + Spacing = 0 + TabOrder = 4 + end + object PredOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 192 + Height = 28 + Top = 217 + Width = 28 + Anchors = [akLeft, akBottom] + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = PredOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object PartInBtn: TBitBtn + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Bevel1 + Left = 64 + Height = 28 + Top = 253 + Width = 28 + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00256929C4216425C9FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002D7533CF488F4DFF458C4AFF2265 + 26D1FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF003C8A430638833ED9519957FF79C07EFF76BF7CFF468D + 4BFF236627DB20622306FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0042924AB83D8C45F765AD6CFF7DC282FF7AC180FF4B92 + 50FF276D2CF7246828BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0043944B384E9A55FF81C587FF7EC385FF317A + 36FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0045954CFF85C78CFF82C689FF3682 + 3DFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004A9E53FF8ACA91FF87C98EFF3C8A + 43FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0050A659FF8ECC95FF8BCB93FF4292 + 4AFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0056AD5FFF93CF9AFF90CE98FF489A + 50FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005BB465FF96D29FFF94D09CFF4EA2 + 57FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005FBB6AFF9AD4A3FF98D3A1FF53AA + 5DFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0063C06FFF9ED6A7FF9CD4A5FF59B2 + 63FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0066C572FFA2D8ABFFA0D7A9FF5DB8 + 68FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0068C774FF67C673FF65C270FF62BE + 6DFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 3 + OnClick = PartInBtnClick + Spacing = 0 + TabOrder = 7 + end + object PartOutBtn: TBitBtn + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrBottom + Left = 100 + Height = 28 + Top = 253 + Width = 28 + BorderSpacing.Top = 8 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00286E2DFF256929FF216425FF1E60 + 22FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002D7533FF74BD7AFF72BD78FF2265 + 26FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00337D39FF79C07EFF76BF7CFF266B + 2BFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0039853FFF7DC282FF7AC180FF2B72 + 30FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003F8D46FF81C587FF7EC385FF317A + 36FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0045954CFF85C78CFF82C689FF3682 + 3DFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004A9E53FF8ACA91FF87C98EFF3C8A + 43FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0050A659FF8ECC95FF8BCB93FF4292 + 4AFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0056AD5FFF93CF9AFF90CE98FF489A + 50FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005BB465FF96D29FFF94D09CFF5DAC + 65FF499C5238FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0065C371BB62BF6EF779C683FF9AD4A3FF98D3A1FF7DC3 + 86FF4FA458F74A9E53B8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0068C7740666C472DB7CCA87FF9ED6A7FF9CD4A5FF73C0 + 7DFF55AC5ED950A65906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0066C572D17ECA88FF7BC885FF5DB8 + 68CFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0067C673C965C270C4FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 2 + OnClick = PartOutBtnClick + Spacing = 0 + TabOrder = 8 + end + object DepVar: TEdit + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOutBtn + AnchorSideBottom.Side = asrBottom + Left = 228 + Height = 23 + Top = 42 + Width = 176 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 3 + Text = 'DepVar' + end + object PredList: TListBox + AnchorSideLeft.Control = PredInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = PredOutBtn + AnchorSideBottom.Side = asrBottom + Left = 229 + Height = 109 + Top = 136 + Width = 175 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 9 + BorderSpacing.Right = 8 + Constraints.MinWidth = 175 + ItemHeight = 0 + TabOrder = 6 + end + object PartList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = VarList + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 105 + Top = 306 + Width = 176 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + Constraints.MinHeight = 100 + ItemHeight = 0 + TabOrder = 9 + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 111 + Height = 25 + Top = 427 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 11 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 177 + Height = 25 + Top = 427 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 12 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 251 + Height = 25 + Top = 427 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 13 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 339 + Height = 25 + Top = 427 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 14 + end + object HelpBtn: TButton + Tag = 136 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 48 + Height = 25 + Top = 427 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 10 + end + object Bevel1: TBevel + AnchorSideLeft.Control = VarList + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrBottom + Left = 92 + Height = 28 + Top = 245 + Width = 8 + Shape = bsSpacer + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 411 + Width = 412 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/correlation/partialsunit.pas b/applications/lazstats/source/forms/analysis/correlation/partialsunit.pas new file mode 100644 index 000000000..14866cf1d --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/partialsunit.pas @@ -0,0 +1,411 @@ +unit PartialsUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, MatrixLib, FunctionsLib, OutputUnit, Globals, ContextHelpUnit; + +type + + { TPartialsFrm } + + TPartialsFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + DepInBtn: TBitBtn; + DepOutBtn: TBitBtn; + HelpBtn: TButton; + PredInBtn: TBitBtn; + PredOutBtn: TBitBtn; + PartInBtn: TBitBtn; + PartOutBtn: TBitBtn; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + DepVar: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + PartList: TListBox; + PredList: TListBox; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure DepInBtnClick(Sender: TObject); + procedure DepOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure PartInBtnClick(Sender: TObject); + procedure PartOutBtnClick(Sender: TObject); + procedure PredInBtnClick(Sender: TObject); + procedure PredOutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + PartialsFrm: TPartialsFrm; + +implementation + +uses + Math; + +{ TPartialsFrm } + +procedure TPartialsFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + DepVar.Text := ''; + VarList.Clear; + PartList.Clear; + PredList.Clear; + DepInBtn.Enabled := true; + DepOutBtn.Enabled := false; + PredInBtn.Enabled := true; + PredOutBtn.Enabled := false; + PartInBtn.Enabled := true; + PartOutBtn.Enabled := false; + for i := 1 to OS3MainFrm.DataGrid.ColCount - 1 do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TPartialsFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TPartialsFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TPartialsFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TPartialsFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TPartialsFrm.PartInBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + PartList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + PartOutBtn.Enabled := true; +end; + +procedure TPartialsFrm.PartOutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := PartList.ItemIndex; + VarList.Items.Add(PartList.Items.Strings[index]); + PartList.Items.Delete(index); + if PartList.Items.Count = 0 then PartOutBtn.Enabled := false; +end; + +procedure TPartialsFrm.PredInBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + PredList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + PredOutBtn.Enabled := true; +end; + +procedure TPartialsFrm.PredOutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := PredList.ItemIndex; + VarList.Items.Add(PredList.Items.Strings[index]); + PredList.Items.Delete(index); + if PredList.Items.Count = 0 then PredOutBtn.Enabled := false; +end; + +procedure TPartialsFrm.DepInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + if index < 0 then exit; + DepVar.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + DepOutBtn.Enabled := true; + DepInBtn.Enabled := false; +end; + +procedure TPartialsFrm.ComputeBtnClick(Sender: TObject); +var + rmatrix, workmat : DblDyneMat; + Means, Variances, StdDevs, W, Betas : DblDyneVec; + R2Full, R2Cntrl, SemiPart, Partial, df1, df2, F, Prob : double; + NoPredVars, NoCntrlVars, DepVarNo, TotNoVars, pcnt, ccnt, count : integer; + PredVars, CntrlVars : IntDyneVec; + MatVars : IntDyneVec; + outline, varstring : string; + i, j, K, L, NCases : integer; + errorcode : boolean; + vtimesw, W1, v : DblDyneMat; + +begin + DepVarNo := 1; + errorcode := false; + + // Get no. of predictor and control variables + NoPredVars := PredList.Items.Count; + NoCntrlVars := PartList.Items.Count; + if (NoPredVars = 0) or (NoCntrlVars = 0) then + begin + ShowMessage('You must select at least one predictor and one control variable!'); + exit; + end; + TotNoVars := NoPredVars + NoCntrlVars + 1; + count := NoCases; + NCases := NoCases; + + // Allocate space required + SetLength(vtimesw,NoVariables,NoVariables); + SetLength(v,NoVariables,NoVariables); + SetLength(W1,NoVariables,NoVariables); + SetLength(rmatrix,NoVariables+1,NoVariables+1); // augmented + SetLength(workmat,NoVariables+1,NoVariables+1); // augmented + SetLength(PredVars,NoVariables); + SetLength(CntrlVars,NoVariables); + SetLength(Means,NoVariables); + SetLength(Variances,NoVariables); + SetLength(StdDevs,NoVariables); + SetLength(W,NoVariables); + SetLength(Betas,NoVariables); + SetLength(MatVars,NoVariables); + + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Partial and Semi-Partial Correlation Analysis'); + OutputFrm.RichEdit.Lines.Add(''); + + // Get column numbers of dependent, predictor and control variables + pcnt := 1; + for i := 0 to NoPredVars - 1 do + begin + varstring := PredList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + if varstring = OS3MainFrm.DataGrid.Cells[j,0] then + begin + PredVars[pcnt-1] := j; + pcnt := pcnt + 1; + end; + end; + end; + ccnt := 1; + for i := 0 to NoCntrlVars - 1 do + begin + varstring := PartList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + if varstring = OS3MainFrm.DataGrid.Cells[j,0] then + begin + CntrlVars[ccnt-1] := j; + ccnt := ccnt + 1; + end; + end; + end; + varstring := DepVar.Text; + for i := 1 to NoVariables do + if varstring = OS3MainFrm.DataGrid.Cells[i,0] then DepVarNo := i; + + outline := format('Dependent variable = %s',[OS3MainFrm.DataGrid.Cells[DepVarNo,0]]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Predictor Variables:'); + for i := 1 to NoPredVars do + begin + outline := format('Variable %d = %s',[i+1,OS3MainFrm.DataGrid.Cells[PredVars[i-1],0]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Control Variables:'); + for i := 1 to NoCntrlVars do + begin + outline := format('Variable %d = %s',[i+1,OS3MainFrm.DataGrid.Cells[CntrlVars[i-1],0]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + if NoPredVars > 1 then + begin + outline := format('Higher order partialling at level = %d',[NoPredVars]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + end; + if NoCntrlVars > 1 then + begin + outline := format('Multiple partialling with %d variables.',[NoCntrlVars]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + end; + + // Now, build the correlation matrix + MatVars[0] := DepVarNo; + for i := 1 to NoPredVars do MatVars[i] := PredVars[i-1]; + for i := 1 to NoCntrlVars do MatVars[i + NoPredVars] := CntrlVars[i-1]; + Correlations(TotNoVars, MatVars, rmatrix, Means, Variances, StdDevs, errorcode, count); + + // Now do Multiple regression models required + // Full model first + for i := 2 to TotNoVars do + for j := 2 to TotNoVars do + workmat[i-2,j-2] := rmatrix[i-1,j-1]; + + matinv(workmat, vtimesw, v, W1, TotNoVars-1); + R2Full := 0.0; + for i := 1 to TotNoVars-1 do // rows + begin + W[i-1] := 0.0; + for j := 1 to TotNoVars - 1 do W[i-1] := W[i-1] + (workmat[i-1,j-1] * rmatrix[0,j]); + R2Full := R2Full + W[i-1] * rmatrix[0,i]; + end; + outline := format('Squared Multiple Correlation with all variables = %6.3f',[R2Full]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Standardized Regression Coefficients:'); + for i := 1 to TotNoVars - 1 do + begin + outline := format('%10s = %6.3f',[OS3MainFrm.DataGrid.Cells[MatVars[i],0],W[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + + // Now do model for Partial and Semi-partial + for i := 1 to NoCntrlVars do + begin + K := i + 1 + NoPredVars; + for j := 1 to NoCntrlVars do + begin + L := j + 1 + NoPredVars; + workmat[i-1,j-1] := rmatrix[K-1,L-1]; + end; + end; + matinv(workmat, vtimesw, v, W1, NoCntrlVars); + R2Cntrl := 0.0; + for i := 1 to NoCntrlVars do + begin + L := i + 1 + NoPredVars; + W[i-1] := 0.0; + for j := 1 to NoCntrlVars do + begin + K := j + 1 + NoPredVars; + W[i-1] := W[i-1] + (workmat[i-1,j-1] * rmatrix[0,K-1]); + end; + R2Cntrl := R2Cntrl + W[i-1] * rmatrix[0,L-1]; + end; + outline := format('Squared Multiple Correlation with control variables = %6.3f',[R2Cntrl]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Standardized Regression Coefficients:'); + for i := 1 to NoCntrlVars do + begin + outline := format('%10s = %6.3f',[OS3MainFrm.DataGrid.Cells[MatVars[i+NoPredVars],0],W[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + + SemiPart := R2Full - R2Cntrl; + Partial := SemiPart / (1.0 - R2Cntrl); + df1 := TotNoVars - 1 - NoCntrlVars; + df2 := count - TotNoVars; + F := (SemiPart / (1.0 - R2Full)) * (df2 / df1); + Prob := probf(F,df1,df2); + + // Report results + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Partial Correlation = %6.3f',[sqrt(Partial)]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Semi-Partial Correlation = %6.3f',[sqrt(SemiPart)]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('F = %8.3f with probability = %6.4f, D.F.1 = %3.0f and D.F.2 = %3.0f',[F,Prob,df1,df2]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + + // clean up the heap + MatVars := nil; + Betas := nil; + W := nil; + Variances := nil; + StdDevs := nil; + Means := nil; + CntrlVars := nil; + PredVars := nil; + workmat := nil; + rmatrix := nil; + v := nil; + W1 := nil; + vtimesw := nil; +end; + +procedure TPartialsFrm.DepOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(DepVar.Text); + DepVar.Text := ''; + DepInBtn.Enabled := true; + DepOutBtn.Enabled := false; +end; + + +initialization + {$I partialsunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/correlation/pointsunit.lfm b/applications/lazstats/source/forms/analysis/correlation/pointsunit.lfm new file mode 100644 index 000000000..182a696f5 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/pointsunit.lfm @@ -0,0 +1,81 @@ +object PointsFrm: TPointsFrm + Left = 506 + Height = 470 + Top = 217 + Width = 736 + Caption = 'Points Form' + ClientHeight = 470 + ClientWidth = 736 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Image1: TImage + Left = 0 + Height = 424 + Top = 0 + Width = 736 + Align = alClient + end + object Panel1: TPanel + Left = 0 + Height = 46 + Top = 424 + Width = 736 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + BorderStyle = bsSingle + ClientHeight = 42 + ClientWidth = 732 + TabOrder = 0 + object MsgEdit: TEdit + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 23 + Top = 10 + Width = 335 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + TabOrder = 0 + Text = 'MsgEdit' + end + object PrintBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ReturnBtn + Left = 600 + Height = 25 + Top = 9 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'Print' + OnClick = PrintBtnClick + TabOrder = 1 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 663 + Height = 25 + Top = 9 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 2 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/correlation/pointsunit.pas b/applications/lazstats/source/forms/analysis/correlation/pointsunit.pas new file mode 100644 index 000000000..1a1f93691 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/pointsunit.pas @@ -0,0 +1,227 @@ +unit PointsUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, Printers, + Globals; + +type + + { TPointsFrm } + + TPointsFrm = class(TForm) + Image1: TImage; + PrintBtn: TButton; + ReturnBtn: TButton; + MsgEdit: TEdit; + Panel1: TPanel; +// procedure FormPaint(Sender: TObject); +// procedure FormResize(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure PrintBtnClick(Sender: TObject); + procedure PtsPlot(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + + private + { private declarations } + + public + { public declarations } + pts : DblDyneVec; + avg : DblDyneVec; + LabelOne : string; + LabelTwo : string; + NoCases : integer; + Title : string; +// Caption : string; + + end; + +var + PointsFrm: TPointsFrm; + +implementation + +{ TPointsFrm } + +uses + Math; + +procedure TPointsFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([PrintBtn.Width, ReturnBtn.Width]); + PrintBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure TPointsFrm.FormShow(Sender: TObject); +begin +// Image1.Canvas.Clear; + Image1.Canvas.Brush.Color := clWhite; + Image1.Canvas.FillRect(0, 0, Image1.Width, Image1.Height); + PtsPlot(self); +end; + +procedure TPointsFrm.PrintBtnClick(Sender: TObject); +var + r : Trect; +begin + with Printer do + begin + Printer.Orientation := poPortrait; + r := Rect(20,20,printer.pagewidth-20,printer.pageheight div 2 + 20); + BeginDoc; + Canvas.StretchDraw(r,Image1.Picture.BitMap); + EndDoc; + end; +end; + +procedure TPointsFrm.PtsPlot(Sender: TObject); +var + topmarg, botmarg, leftmarg, rightmarg, verthi, horizlong : integer; + X, Y, yincrement, labelheight, i: integer; + labelstring, labelstr : string; + Xstep, Ystep, yprop, scaley, xprop, scalex, Min, Max : double; +begin + height := Image1.Canvas.Height; + width := Image1.Canvas.Width; + topmarg := height div 10; + verthi := height - (2 * topmarg); + botmarg := topmarg + verthi; + botmarg := height; + leftmarg := width div 10; + horizlong := width - 2 * leftmarg; + rightmarg := leftmarg + horizlong; + // get max and min of values to plot + Max := -1000.0; + Min := 1000.0; + for i := 0 to NoCases - 1 do + begin + if (pts[i] > Max) then Max := pts[i]; + if (avg[i] > Max) then Max := avg[i]; + if (pts[i] < Min) then Min := pts[i]; + if (avg[i] < Min) then Min := avg[i]; + end; + yincrement := verthi div 20; + Image1.Canvas.Pen.Color := clBlack; + + // print title at top, centered + labelstring := 'Plot of Original and '; + labelstring := labelstring + Title; +// labelstring := labelstring + DepVarEdit.Text; + X := (leftmarg + horizlong div 2) - (Image1.Canvas.TextWidth(labelstring) div 2); + Y := 1; + Image1.Canvas.TextOut(X,Y,labelstring); + + // draw left axis + X := leftmarg; + Y := botmarg; + Image1.Canvas.MoveTo(X,Y); + Y := topmarg; + Image1.Canvas.LineTo(X,Y); + + // scale to left of vertical axis + Ystep := (Max - Min) / 20; + for i := 0 to 20 do + begin + Y := topmarg + (i * yincrement); + labelstr := format('%4.2f -',[Max - (Ystep * i)]); + labelstring := labelstr; + X := leftmarg - Image1.Canvas.TextWidth(labelstring); + Image1.Canvas.TextOut(X,Y,labelstring); + end; + + // Make legend axis on bottom + X := leftmarg; + Y := botmarg; + Xstep := horizlong / 20; + xprop := NoCases / 20; + Image1.Canvas.MoveTo(X,Y); + X := rightmarg; + Image1.Canvas.LineTo(X,Y); + for i := 0 to 20 do + begin + X := leftmarg + round(Xstep * i); + labelstring := '|'; + Image1.Canvas.TextOut(X,Y,labelstring); + labelstring := IntToStr(round((xprop * i) + 1)); + Y := Y + 5; + Image1.Canvas.TextOut(X,Y,labelstring); + Y := botmarg; + end; + labelstring := 'CASES'; + X := (leftmarg + horizlong div 2) - (Canvas.TextWidth(labelstring) div 2); + Y := botmarg + Image1.Canvas.TextHeight(labelstring); + Image1.Canvas.TextOut(X,Y,labelstring); + + // Plot lines from point to point + Image1.Canvas.Pen.Color := clRed; + for i := 0 to NoCases - 1 do + begin + yprop := (Max - pts[i]) / (Max - Min); + scaley := yprop * verthi; + xprop := i / NoCases; + scalex := xprop * horizlong; + X := leftmarg + round(scalex); + Y := topmarg + round(scaley); + if (i = 0) then Image1.Canvas.MoveTo(X,Y) + else Image1.Canvas.LineTo(X,Y); + Image1.Canvas.Ellipse(X-3,Y-3,X+3,Y+3); + end; + + // Plot average points + Image1.Canvas.Pen.Color := clBlue; + for i := 0 to NoCases - 1 do + begin + yprop := (Max - avg[i]) / (Max - Min); + scaley := yprop * verthi; + xprop := i / NoCases; + scalex := xprop * horizlong; + X := leftmarg + round(scalex); + Y := topmarg + round(scaley); + if (i = 0) then Image1.Canvas.MoveTo(X,Y) + else Image1.Canvas.LineTo(X,Y); + Image1.Canvas.Ellipse(X-3,Y-3,X+3,Y+3); + end; + + // Show legend at right + X := rightmarg; + labelstring := LabelOne; + labelheight := Image1.Canvas.TextHeight(labelstring); + Y := 5 * labelheight; + Image1.Canvas.Font.Color := clRed; + Image1.Canvas.TextOut(X,Y,labelstring); + labelstring := LabelTwo; + Y := 6 * labelheight; + Image1.Canvas.Font.Color := clBlue; + Image1.Canvas.TextOut(X,Y,labelstring); +end; + +procedure TPointsFrm.ReturnBtnClick(Sender: TObject); +begin + PointsFrm.Hide; +end; + +{ +procedure TPointsFrm.FormPaint(Sender: TObject); +begin + PtsPlot; +end; + +procedure TPointsFrm.FormResize(Sender: TObject); +begin + PtsPlot; +end; +} +initialization + {$I pointsunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/correlation/polynomialunit.lfm b/applications/lazstats/source/forms/analysis/correlation/polynomialunit.lfm new file mode 100644 index 000000000..d1c6d62e3 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/polynomialunit.lfm @@ -0,0 +1,128 @@ +object PolynomialFrm: TPolynomialFrm + Left = 822 + Height = 99 + Top = 421 + Width = 351 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Polynomial Regression Smoothing' + ClientHeight = 99 + ClientWidth = 351 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = OKBtn + Left = 223 + Height = 25 + Top = 63 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object OKBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 297 + Height = 25 + Top = 63 + Width = 42 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'OK' + ModalResult = 1 + TabOrder = 3 + end + object HelpBtn: TButton + Tag = 139 + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CancelBtn + Left = 160 + Height = 25 + Top = 63 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 1 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 99 + Height = 23 + Top = 16 + Width = 152 + AutoSize = True + BorderSpacing.Left = 100 + BorderSpacing.Top = 16 + BorderSpacing.Right = 100 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 23 + ClientWidth = 152 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = PolyEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = PolyEdit + Left = 0 + Height = 15 + Top = 4 + Width = 97 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Polynomial order :' + ParentColor = False + end + object PolyEdit: TEdit + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 105 + Height = 23 + Top = 0 + Width = 47 + Alignment = taRightJustify + Anchors = [akTop, akRight] + TabOrder = 0 + Text = 'PolyEdit' + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 47 + Width = 351 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/correlation/polynomialunit.pas b/applications/lazstats/source/forms/analysis/correlation/polynomialunit.pas new file mode 100644 index 000000000..a31179c84 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/polynomialunit.pas @@ -0,0 +1,69 @@ +unit PolynomialUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + ContextHelpUnit; + +type + + { TPolynomialFrm } + + TPolynomialFrm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + HelpBtn: TButton; + OKBtn: TButton; + Panel1: TPanel; + PolyEdit: TEdit; + Label1: TLabel; + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + PolynomialFrm: TPolynomialFrm; + +implementation + +uses + Math; + +{ TPolynomialFrm } + +procedure TPolynomialFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([HelpBtn.Width, CancelBtn.Width, OKBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + OKBtn.Constraints.MinWidth := w; +end; + +procedure TPolynomialFrm.FormShow(Sender: TObject); +begin + PolyEdit.Text := '1'; +end; + +procedure TPolynomialFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +initialization + {$I polynomialunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/correlation/rmatunit.lfm b/applications/lazstats/source/forms/analysis/correlation/rmatunit.lfm new file mode 100644 index 000000000..3e0c1659d --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/rmatunit.lfm @@ -0,0 +1,389 @@ +object RMatFrm: TRMatFrm + Left = 597 + Height = 482 + Top = 185 + Width = 409 + AutoSize = True + Caption = 'Product-Moment Correlations' + ClientHeight = 482 + ClientWidth = 409 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 114 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables to Correlate:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ListBox1 + AnchorSideTop.Control = Owner + Left = 235 + Height = 15 + Top = 8 + Width = 96 + BorderSpacing.Top = 8 + Caption = 'Selected Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 223 + Top = 25 + Width = 165 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 190 + Height = 28 + Top = 29 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 190 + Height = 28 + Top = 64 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 181 + Height = 25 + Top = 120 + Width = 46 + AutoSize = True + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 3 + end + object ListBox1: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 235 + Height = 223 + Top = 25 + Width = 166 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + TabOrder = 4 + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 177 + Top = 256 + Width = 393 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Options:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 7 + ClientHeight = 157 + ClientWidth = 389 + TabOrder = 5 + object CPChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 222 + Caption = 'Show Cross-Products Matrix' + TabOrder = 0 + end + object CovChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 222 + Caption = 'Show Variance-Covariance Matrix' + TabOrder = 1 + end + object CorrsChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 222 + Caption = 'Show the Intercorrelation Matrix' + TabOrder = 2 + end + object MeansChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 222 + Caption = 'Show Means' + TabOrder = 3 + end + object VarChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 90 + Width = 222 + Caption = 'Show Variances' + TabOrder = 4 + end + object SDChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 111 + Width = 222 + Caption = 'Show Standard Deviations' + TabOrder = 5 + end + object PairsChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 132 + Width = 222 + Caption = 'Pair-Wise Calculations' + TabOrder = 6 + end + object AugmentChk: TCheckBox + Left = 234 + Height = 19 + Top = 6 + Width = 143 + Caption = 'Autmented' + TabOrder = 7 + end + object GridMatChk: TCheckBox + Left = 234 + Height = 19 + Top = 27 + Width = 143 + Caption = 'Save Matrix to Grid' + TabOrder = 8 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 108 + Height = 25 + Top = 449 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 7 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 174 + Height = 25 + Top = 449 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 8 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 248 + Height = 25 + Top = 449 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 9 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 336 + Height = 25 + Top = 449 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 10 + end + object HelpBtn: TButton + Tag = 144 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 45 + Height = 25 + Top = 449 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 6 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 433 + Width = 409 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/correlation/rmatunit.pas b/applications/lazstats/source/forms/analysis/correlation/rmatunit.pas new file mode 100644 index 000000000..00ef1671a --- /dev/null +++ b/applications/lazstats/source/forms/analysis/correlation/rmatunit.pas @@ -0,0 +1,479 @@ +unit RMatUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, MatrixLib, OutputUnit, DataProcs, FunctionsLib, + ContextHelpUnit; + +type + + { TRMatFrm } + + TRMatFrm = class(TForm) + Bevel1: TBevel; + GridMatChk: TCheckBox; + HelpBtn: TButton; + InBtn: TBitBtn; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + AugmentChk: TCheckBox; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + CPChkBox: TCheckBox; + CovChkBox: TCheckBox; + CorrsChkBox: TCheckBox; + MeansChkBox: TCheckBox; + VarChkBox: TCheckBox; + SDChkBox: TCheckBox; + PairsChkBox: TCheckBox; + GroupBox1: TGroupBox; + Label1: TLabel; + Label2: TLabel; + ListBox1: TListBox; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure PairsCalc(NoVars : integer; + VAR ColNoSelected : IntDyneVec; + VAR Matrix : DblDyneMat; + VAR ColLabels : StrDyneVec); + + public + { public declarations } + end; + +var + RMatFrm: TRMatFrm; + +implementation + +uses + Math; + +{ TRMatFrm } + +procedure TRMatFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + ListBox1.Clear; + for i := 1 to NoVariables do + begin + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + end; + InBtn.Enabled := true; + OutBtn.Enabled := false; + AugmentChk.Checked := false; + PairsChkBox.Checked := false; + CPChkBox.Checked := false; + CovChkBox.Checked := false; + CorrsChkBox.Checked := true; + MeansChkBox.Checked := true; + VarChkBox.Checked := false; + SDChkBox.Checked := true; +end; + +procedure TRMatFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TRMatFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TRMatFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TRMatFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TRMatFrm.AllBtnClick(Sender: TObject); +VAR count, index : integer; +begin + count := VarList.Items.Count; + for index := 0 to count-1 do + begin + ListBox1.Items.Add(VarList.Items.Strings[index]); + end; + VarList.Clear; +end; + +procedure TRMatFrm.ComputeBtnClick(Sender: TObject); +label cleanit; +var + i, j : integer; + cellstring : string; + NoVars : integer; + ColNoSelected : IntDyneVec; + Matrix : DblDyneMat; + TestMat : DblDyneMat; + Means : DblDyneVec; + Variances : DblDyneVec; + StdDevs : DblDyneVec; + RowLabels, ColLabels : StrDyneVec; + Augment : boolean; + title : string; + errorcode : boolean; + Ngood : integer; + t, Probr, N: double; +begin + errorcode := false; + OutputFrm.RichEdit.Clear; + NoVars := ListBox1.Items.Count; + Augment := false; + Ngood := 0; + + SetLength(ColNoSelected,NoVars+1); + SetLength(Matrix,NoVars+1,NoVars+1); // 1 more for possible augmentation + SetLength(TestMat,NoVars,NoVars); + SetLength(Means,NoVars+1); + SetLength(Variances,NoVars+1); + SetLength(StdDevs,NoVars+1); + SetLength(RowLabels,NoVars+1); + SetLength(ColLabels,NoVars+1); + + // identify the included variable locations and their labels + for i := 1 to NoVars do + begin + cellstring := ListBox1.Items.Strings[i-1]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[i-1] := j; + RowLabels[i-1] := cellstring; + ColLabels[i-1] := cellstring; + end; + end; + end; + + if PairsChkBox.Checked then + begin + PairsCalc(NoVars,ColNoSelected,Matrix,ColLabels); + goto cleanit; + end; + + if AugmentChk.Checked then + begin + Augment := true; + ColLabels[NoVars] := 'Intercept'; + RowLabels[NoVars] := 'Intercept'; + end; + + // get cross-products if elected + if CPChkBox.Checked = true then + begin + GridXProd(NoVars,ColNoSelected,Matrix,Augment,Ngood); + title := 'Cross-Products Matrix'; + if NOT Augment then + MAT_PRINT(Matrix,NoVars,NoVars,title,RowLabels,ColLabels,Ngood) + else + MAT_PRINT(Matrix,NoVars+1,NoVars+1,title,RowLabels,ColLabels,Ngood); + end; + + if CovChkBox.Checked = true then // get variance-covariance mat. if elected + begin + title := 'Variance-Covariance Matrix'; + GridCovar(NoVars,ColNoSelected,Matrix,Means,Variances,StdDevs,errorcode, Ngood); + MAT_PRINT(Matrix,NoVars,NoVars,title,RowLabels,ColLabels,Ngood); + end; + + if CorrsChkBox.Checked = true then // get correlations + begin + title := 'Product-Moment Correlations Matrix'; + Correlations(NoVars,ColNoSelected,Matrix,Means,Variances,StdDevs,errorcode,Ngood); + MAT_PRINT(Matrix,NoVars,NoVars,title,RowLabels,ColLabels,Ngood); + N := Ngood; + for i := 1 to NoVars do + begin + for j := i+1 to NoVars do + begin + t := Matrix[i-1][j-1] * (sqrt((N-2.0) / + (1.0 - (Matrix[i-1][j-1] * Matrix[i-1][j-1])))); + TestMat[i-1,j-1] := t; + Probr := probt(t,N - 2.0); + TestMat[j-1,i-1] := Probr; + TestMat[i-1,i-1] := 0.0; + + end; + end; + title := 't-test values (upper) and probabilities of t (lower)'; + MAT_PRINT(TestMat,NoVars,NoVars,title,RowLabels,ColLabels,Ngood); + end; + + title := 'Means'; + if MeansChkBox.Checked = true then + DynVectorPrint(Means,NoVars,title,ColLabels,Ngood); + + title := 'Variances'; + if VarChkBox.Checked = true then + DynVectorPrint(Variances,NoVars,title,ColLabels,Ngood); + + title := 'Standard Deviations'; + if SDChkBox.Checked = true then + DynVectorPrint(StdDevs,NoVars,title,ColLabels,Ngood); + + if errorcode then + OutputFrm.RichEdit.Lines.Add('One or more correlations could not be computed due to zero variance of a variable.'); + + OutputFrm.ShowModal; + + if GridMatChk.Checked then MatToGrid(Matrix,NoVars); + // clean up the heap +cleanit: + ColLabels := nil; + RowLabels := nil; + StdDevs := nil; + Variances := nil; + Means := nil; + Matrix := nil; + ColNoSelected := nil; +end; + +procedure TRMatFrm.InBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + ListBox1.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + + OutBtn.Enabled := true; +end; + +procedure TRMatFrm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := ListBox1.ItemIndex; + VarList.Items.Add(ListBox1.Items.Strings[index]); + ListBox1.Items.Delete(index); + InBtn.Enabled := true; +end; + +procedure TRMatFrm.PairsCalc(NoVars: integer; var ColNoSelected: IntDyneVec; + var Matrix: DblDyneMat; var ColLabels: StrDyneVec); +Label nextpart; +var + i, j, k, XCol, YCol, Npairs, N : integer; + X, Y, XMean, XVar, XSD, YMean, YVar, YSD, pmcorr, z, rprob : double; + strout : string; + NMatrix : IntDyneMat; + tMatrix : DblDyneMat; + ProbMat : DblDyneMat; + startpos, endpos : integer; + +begin + OutputFrm.RichEdit.Clear; + SetLength(NMatrix,NoVars,NoVars); + SetLength(tMatrix,NoVars,NoVars); + SetLength(ProbMat,NoVars,NoVars); + + for i := 1 to NoVars - 1 do + begin + for j := i + 1 to NoVars do + begin + XMean := 0.0; + XVar := 0.0; + XCol := ColNoSelected[i-1]; + YMean := 0.0; + YVar := 0.0; + YCol := ColNoSelected[j-1]; + pmcorr := 0.0; + Npairs := 0; + strout := ColLabels[i-1]; + strout := strout + ' vs '; + strout := strout + ColLabels[j-1]; + OutputFrm.RichEdit.Lines.Add(strout); + for k := 1 to NoCases do + begin + if not ValidValue(k,XCol) then continue; + if not ValidValue(k,YCol) then continue; + X := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,k]); + Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,k]); + pmcorr := pmcorr + (X * Y); + XMean := XMean + X; + YMean := YMean + Y; + XVar := XVar + (X * X); + YVar := YVar + (Y * Y); + Npairs := NPairs + 1; + end; + if CPChkBox.Checked then + begin + strout := format('CrossProducts[%d,%d]=%6.4f, N cases = %d',[i,j,pmcorr,Npairs]); + OutputFrm.RichEdit.Lines.Add(strout); + end; + pmcorr := pmcorr - (XMean * YMean) / Npairs; + pmcorr := pmcorr / (Npairs - 1); + if CovChkBox.Checked then + begin + strout := format('Covariance[%d,%d]=%6.4f, N cases = %d',[i,j,pmcorr,Npairs]); + OutputFrm.RichEdit.Lines.Add(strout); + end; + XVar := XVar - (XMean * XMean) / Npairs; + XVar := XVar / (Npairs - 1); + XSD := sqrt(XVar); + YVar := YVar - (YMean * YMean) / Npairs; + YVar := YVar / (Npairs - 1); + YSD := sqrt(YVar); + XMean := XMean / Npairs; + YMean := YMean / Npairs; + pmcorr := pmcorr / (XSD * YSD); + Matrix[i-1,j-1] := pmcorr; + Matrix[j-1,i-1] := pmcorr; + NMatrix[i-1,j-1] := Npairs; + NMatrix[j-1,i-1] := NPairs; + if CorrsChkBox.Checked then + begin + N := Npairs - 2; + z := abs(pmcorr) * (sqrt((N-2)/(1.0 - (pmcorr * pmcorr)))); + rprob := probt(z,N); +// Using Fisher's z transform below gives SPSS results +// N := Npairs - 3; +// z := 0.5 * ln( (1.0 + pmcorr)/(1.0 - pmcorr) ); +// z := z / sqrt(1.0/N); +// rprob := probz(z); + strout := format('r[%d,%d]=%6.4f, N cases = %d',[i,j,pmcorr,Npairs]); + OutputFrm.RichEdit.Lines.Add(strout); + strout := format('t value with d.f. %d = %8.4f with Probability > t = %6.4f',[Npairs-2,z,rprob]); + OutputFrm.RichEdit.Lines.Add(strout); + tMatrix[i-1,j-1] := z; + tMatrix[j-1,i-1] := z; + ProbMat[i-1,j-1] := rprob; + ProbMat[j-1,i-1] := rprob; + end; + if MeansChkBox.Checked or VarChkBox.Checked or SDChkBox.Checked then + begin + strout := format('Mean X = %8.4f, Variance X = %8.4f, Std.Dev. X = %8.4f',[XMean,XVar,XSD]); + OutputFrm.RichEdit.Lines.Add(strout); + strout := format('Mean Y = %8.4f, Variance Y = %8.4f, Std.Dev. Y = %8.4f',[YMean,YVar,YSD]); + OutputFrm.RichEdit.Lines.Add(strout); + end; + OutputFrm.RichEdit.Lines.Add(''); + end; // next j variable + Matrix[i-1,i-1] := 1.0; + end; // next i variable + Matrix[NoVars-1,NoVars-1] := 1.0; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Intercorrelation Matrix and Statistics'); + OutputFrm.RichEdit.Lines.Add(''); +// strout := 'Correlation Matrix Summary (Ns in lower triangle)'; +// MAT_PRINT(Matrix,NoVars,NoVars,strout,ColLabels,ColLabels,NoCases); + startpos := 1; + endpos := 6; + if endpos > NoVars then endpos := NoVars; + for i := 1 to NoVars do + begin +nextpart: + strout := ' '; + for j := startpos to endpos do + strout := strout + format(' %5d',[j]); + OutputFrm.RichEdit.Lines.Add(strout); + strout := format('%2d PMCorr.',[i]); + for j := startpos to endpos do + strout := strout + format(' %7.4f',[Matrix[i-1,j-1]]); + OutputFrm.RichEdit.Lines.Add(strout); + strout := format('%2d N Size ',[i]); + for j := startpos to endpos do + begin + if j <> i then + strout := strout + format(' %3d ',[NMatrix[i-1,j-1]]) + else begin + Npairs := 0; + for k := 1 to NoCases do + begin + if ValidValue(k,ColNoSelected[j-1]) + then Npairs := Npairs + 1; + end; + strout := strout + format(' %3d ',[Npairs]); + end; + end; + OutputFrm.RichEdit.Lines.Add(strout); + strout := format('%2d t Value',[i]); + for j := startpos to endpos do + begin + if j <> i then + strout := strout + format(' %7.4f',[tMatrix[i-1,j-1]]) + else strout := strout + ' '; + end; + OutputFrm.RichEdit.Lines.Add(strout); + strout := format('%2d Prob. t',[i]); + for j := startpos to endpos do + begin + if j <> i then + strout := strout + format(' %7.4f',[ProbMat[i-1,j-1]]) + else strout := strout + ' '; + end; + OutputFrm.RichEdit.Lines.Add(strout); + OutputFrm.RichEdit.Lines.Add(''); + if endpos < NoVars then + begin + startpos := endpos + 1; + endpos := endpos + 6; + if endpos > NoVars then endpos := NoVars; + goto nextpart; + end; + end; + OutputFrm.ShowModal; + + ProbMat := nil; + tMatrix := nil; + NMatrix := nil; +end; + +initialization + {$I rmatunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/cross-classification/abcloglinunit.lfm b/applications/lazstats/source/forms/analysis/cross-classification/abcloglinunit.lfm new file mode 100644 index 000000000..d0989e65f --- /dev/null +++ b/applications/lazstats/source/forms/analysis/cross-classification/abcloglinunit.lfm @@ -0,0 +1,528 @@ +object ABCLogLinearFrm: TABCLogLinearFrm + Left = 596 + Height = 432 + Top = 216 + Width = 371 + AutoSize = True + Caption = 'Log Linear Analysis for AxBxC Classification Table' + ClientHeight = 432 + ClientWidth = 371 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 162 + Height = 25 + Top = 399 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 224 + Height = 25 + Top = 399 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 308 + Height = 25 + Top = 399 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 5 + end + object HelpBtn: TButton + Tag = 101 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 103 + Height = 25 + Top = 399 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 2 + end + object Notebook1: TNotebook + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = FileFromGrp + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 316 + Top = 67 + Width = 355 + PageIndex = 0 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 1 + object Page1: TPage + object Label3: TLabel + AnchorSideLeft.Control = RowVarEdit + AnchorSideBottom.Control = RowVarEdit + Left = 199 + Height = 15 + Top = 8 + Width = 67 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Row Variable' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = ColVarEdit + AnchorSideBottom.Control = ColVarEdit + Left = 199 + Height = 15 + Top = 84 + Width = 87 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Column Variable' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = SliceVarEdit + AnchorSideBottom.Control = SliceVarEdit + Left = 199 + Height = 15 + Top = 160 + Width = 68 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Slice Variable' + ParentColor = False + end + object Label6: TLabel + AnchorSideLeft.Control = FreqVarEdit + AnchorSideBottom.Control = FreqVarEdit + Left = 199 + Height = 15 + Top = 236 + Width = 99 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Frequency Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Page1 + AnchorSideTop.Control = Page1 + AnchorSideRight.Control = RowInBtn + AnchorSideBottom.Control = Page1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 316 + Top = 0 + Width = 155 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object RowInBtn: TBitBtn + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 163 + Height = 28 + Top = 0 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = RowInBtnClick + Spacing = 0 + TabOrder = 1 + end + object RowOutBtn: TBitBtn + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = RowInBtn + AnchorSideTop.Side = asrBottom + Left = 163 + Height = 28 + Top = 32 + Width = 28 + BorderSpacing.Top = 4 + Enabled = False + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = RowOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object ColInBtn: TBitBtn + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = RowOutBtn + AnchorSideTop.Side = asrBottom + Left = 163 + Height = 28 + Top = 76 + Width = 28 + BorderSpacing.Top = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ColInBtnClick + Spacing = 0 + TabOrder = 4 + end + object ColOutBtn: TBitBtn + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ColInBtn + AnchorSideTop.Side = asrBottom + Left = 163 + Height = 28 + Top = 108 + Width = 28 + BorderSpacing.Top = 4 + Enabled = False + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ColOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object SliceBtnIn: TBitBtn + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ColOutBtn + AnchorSideTop.Side = asrBottom + Left = 163 + Height = 28 + Top = 152 + Width = 28 + BorderSpacing.Top = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = SliceBtnInClick + Spacing = 0 + TabOrder = 7 + end + object SliceBtnOut: TBitBtn + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = SliceBtnIn + AnchorSideTop.Side = asrBottom + Left = 163 + Height = 28 + Top = 184 + Width = 28 + BorderSpacing.Top = 4 + Enabled = False + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = SliceBtnOutClick + Spacing = 0 + TabOrder = 8 + end + object FreqInBtn: TBitBtn + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = SliceBtnOut + AnchorSideTop.Side = asrBottom + Left = 163 + Height = 28 + Top = 228 + Width = 28 + BorderSpacing.Top = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = FreqInBtnClick + Spacing = 0 + TabOrder = 10 + end + object FreqOutBtn: TBitBtn + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = FreqInBtn + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 163 + Height = 28 + Top = 260 + Width = 28 + BorderSpacing.Top = 4 + Enabled = False + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = FreqOutBtnClick + Spacing = 0 + TabOrder = 11 + end + object RowVarEdit: TEdit + AnchorSideLeft.Control = RowInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Page1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = RowOutBtn + AnchorSideBottom.Side = asrBottom + Left = 199 + Height = 23 + Top = 25 + Width = 156 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'RowVarEdit' + end + object ColVarEdit: TEdit + AnchorSideLeft.Control = ColInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Page1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ColOutBtn + AnchorSideBottom.Side = asrBottom + Left = 199 + Height = 23 + Top = 101 + Width = 156 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'ColVarEdit' + end + object SliceVarEdit: TEdit + AnchorSideLeft.Control = SliceBtnIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Page1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = SliceBtnOut + AnchorSideBottom.Side = asrBottom + Left = 199 + Height = 23 + Top = 177 + Width = 156 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 9 + Text = 'SliceVarEdit' + end + object FreqVarEdit: TEdit + AnchorSideLeft.Control = FreqInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Page1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = FreqOutBtn + AnchorSideBottom.Side = asrBottom + Left = 199 + Height = 23 + Top = 253 + Width = 156 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 12 + Text = 'FreqVarEdit' + end + end + object Page2: TPage + object Label1: TLabel + AnchorSideLeft.Control = Page2 + AnchorSideTop.Control = NRowsEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 4 + Width = 67 + Caption = 'No. of Rows:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = NRowsEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrCenter + Left = 134 + Height = 15 + Top = 4 + Width = 65 + BorderSpacing.Left = 16 + Caption = 'No. of Cols.:' + ParentColor = False + end + object Label7: TLabel + AnchorSideLeft.Control = NColsEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrCenter + Left = 270 + Height = 15 + Top = 4 + Width = 68 + BorderSpacing.Left = 16 + Caption = 'No. of Slices:' + ParentColor = False + end + object NRowsEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Page2 + Left = 75 + Height = 23 + Top = 0 + Width = 43 + Alignment = taRightJustify + BorderSpacing.Left = 8 + OnKeyPress = NRowsEditKeyPress + TabOrder = 0 + Text = 'NRowsEdit' + end + object NColsEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Page2 + Left = 207 + Height = 23 + Top = 0 + Width = 47 + Alignment = taRightJustify + BorderSpacing.Left = 8 + OnKeyPress = NColsEditKeyPress + TabOrder = 1 + Text = 'NColsEdit' + end + object Grid: TStringGrid + AnchorSideLeft.Control = Page2 + AnchorSideTop.Control = NRowsEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Page2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Page2 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 339 + Top = 31 + Width = 444 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 8 + ColCount = 2 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goTabs, goSmoothScroll] + RowCount = 2 + TabOrder = 2 + end + object NslicesEdit: TEdit + AnchorSideLeft.Control = Label7 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Page2 + Left = 346 + Height = 23 + Top = 0 + Width = 39 + Alignment = taRightJustify + BorderSpacing.Left = 8 + OnKeyPress = NslicesEditKeyPress + TabOrder = 3 + Text = 'NslicesEdit' + end + end + end + object FileFromGrp: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 51 + Top = 8 + Width = 354 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Enter Data From:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 16 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 31 + ClientWidth = 350 + Columns = 2 + Items.Strings = ( + 'File Data in the Main Grid' + 'Data Entered on this Form' + ) + OnClick = FileFromGrpClick + TabOrder = 0 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 383 + Width = 371 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Bevel2: TBevel + Left = 1 + Height = 12 + Top = 434 + Width = 10 + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/cross-classification/abcloglinunit.pas b/applications/lazstats/source/forms/analysis/cross-classification/abcloglinunit.pas new file mode 100644 index 000000000..4304dd199 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/cross-classification/abcloglinunit.pas @@ -0,0 +1,1051 @@ +unit ABCLogLinUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, Buttons, Grids, + OutputUnit, MainUnit, Globals, DataProcs, ContextHelpUnit; + +type + + { TABCLogLinearFrm } + + TABCLogLinearFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + HelpBtn: TButton; + Notebook1: TNotebook; + Page1: TPage; + Page2: TPage; + RowInBtn: TBitBtn; + RowOutBtn: TBitBtn; + ColInBtn: TBitBtn; + ColOutBtn: TBitBtn; + SliceBtnIn: TBitBtn; + SliceBtnOut: TBitBtn; + FreqInBtn: TBitBtn; + FreqOutBtn: TBitBtn; + NslicesEdit: TEdit; + Label7: TLabel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + NRowsEdit: TEdit; + NColsEdit: TEdit; + RowVarEdit: TEdit; + ColVarEdit: TEdit; + SliceVarEdit: TEdit; + FreqVarEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Grid: TStringGrid; + VarList: TListBox; + FileFromGrp: TRadioGroup; + procedure ColInBtnClick(Sender: TObject); + procedure ColOutBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FileFromGrpClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure FreqInBtnClick(Sender: TObject); + procedure FreqOutBtnClick(Sender: TObject); + procedure NColsEditKeyPress(Sender: TObject; var Key: char); + procedure NRowsEditKeyPress(Sender: TObject; var Key: char); + procedure NslicesEditKeyPress(Sender: TObject; var Key: char); + procedure ResetBtnClick(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure RowInBtnClick(Sender: TObject); + procedure RowOutBtnClick(Sender: TObject); + procedure SliceBtnInClick(Sender: TObject); + procedure SliceBtnOutClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure ModelEffect( + Nrows, Ncols, Nslices: integer; + const Data: DblDyneCube; + const RowMarg, ColMarg, SliceMarg : DblDyneVec; + const AB, AC, BC: DblDyneMat; + var Total: double; Model: integer; AReport: TStrings); + procedure Iterate( + Nrows, Ncols, Nslices: integer; + const Data: DblDyneCube; + const RowMarg, ColMarg, SliceMarg: DblDyneVec; + var Total: double; + const Expected: DblDyneCube; + const NewRowMarg, NewColMarg, NewSliceMarg: DblDyneVec; + var NewTotal: double); + + procedure PrintTable(Nrows, Ncols, Nslices: integer; + const Data: DblDyneCube; const RowMarg, ColMarg, SliceMarg: DblDyneVec; + Total: double; AReport: TStrings); + procedure PrintLamdas(Nrows,Ncols,Nslices: integer; + const CellLambdas: DblDyneQuad; mu: double; AReport: TStrings); + procedure PrintMatrix(const X: DblDyneMat; + Nrows, Ncols: integer; Title: string; AReport: TStrings); + + procedure UpdateBtnStates; + + public + { public declarations } + end; + +var + ABCLogLinearFrm: TABCLogLinearFrm; + +implementation + +uses + Math; + +{ TABCLogLinearFrm } + +procedure TABCLogLinearFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + Grid.ColCount := 4; + Grid.RowCount := 2; + Grid.Cells[0,0] := 'ROW'; + Grid.Cells[1,0] := 'COL'; + Grid.Cells[2,0] := 'SLICE'; + Grid.Cells[3,0] := 'FREQ.'; + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + RowVarEdit.Text := ''; + ColVarEdit.Text := ''; + SliceVarEdit.Text := ''; + FreqVarEdit.Text := ''; + NRowsEdit.Text := ''; + NColsEdit.Text := ''; + NSlicesEdit.Text := ''; + FileFromGrp.ItemIndex := -1; + Notebook1.Hide; + UpdateBtnStates; +end; + +procedure TABCLogLinearFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TABCLogLinearFrm.RowInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (RowVarEdit.Text = '') then + begin + RowVarEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TABCLogLinearFrm.RowOutBtnClick(Sender: TObject); +begin + if RowVarEdit.Text <> '' then + begin + VarList.Items.Add(RowVarEdit.Text); + RowVarEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TABCLogLinearFrm.SliceBtnInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (SliceVarEdit.Text = '') then + begin + SliceVarEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TABCLogLinearFrm.SliceBtnOutClick(Sender: TObject); +begin + if SliceVarEdit.Text <> '' then + begin + VarList.Items.Add(SliceVarEdit.Text); + SliceVarEdit.Text := ''; + end; +end; + +procedure TABCLogLinearFrm.VarListSelectionChange(Sender: TObject; + User: boolean); +begin + UpdateBtnStates; +end; + +procedure TABCLogLinearFrm.FileFromGrpClick(Sender: TObject); +begin + NoteBook1.Show; + NoteBook1.PageIndex := fileFromGrp.ItemIndex; + { + if FileFromGrp.ItemIndex = 0 then // file from main form + begin + VarList.Visible := true; + RowInBtn.Visible := true; + RowOutBtn.Visible := false; + ColInBtn.Visible := true; + ColOutBtn.Visible := false; + SliceBtnIn.Visible := true; + SliceBtnOut.Visible := false; + FreqInBtn.Visible := true; + FreqOutBtn.Visible := false; + Label4.Visible := true; + Label5.Visible := true; + Label6.Visible := true; + Label3.Visible := true; + RowVarEdit.Visible := true; + ColVarEdit.Visible := true; + SliceVarEdit.Visible := true; + FreqVarEdit.Visible := true; + Label1.Visible := false; + Label2.Visible := false; + Label7.Visible := false; + NRowsEdit.Visible := false; + NColsEdit.Visible := false; + NSlicesEdit.Visible := false; + Grid.Visible := false; + end; + if FileFromGrp.ItemIndex = 1 then // data from this form + begin + VarList.Visible := false; + RowInBtn.Visible := false; + RowOutBtn.Visible := false; + ColInBtn.Visible := false; + ColOutBtn.Visible := false; + SliceBtnIn.Visible := false; + SliceBtnOut.Visible := false; + FreqInBtn.Visible := false; + FreqOutBtn.Visible := false; + Label4.Visible := false; + Label5.Visible := false; + Label6.Visible := false; + Label3.Visible := false; + RowVarEdit.Visible := false; + ColVarEdit.Visible := false; + SliceVarEdit.Visible := false; + FreqVarEdit.Visible := false; + Label1.Visible := true; + Label2.Visible := true; + Label7.Visible := true; + NRowsEdit.Visible := true; + NColsEdit.Visible := true; + NSlicesEdit.Visible := true; + Grid.Visible := true; + end; + } +end; + +procedure TABCLogLinearFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinHeight := FreqOutBtn.Top + FreqOutBtn.Height - VarList.Top; + Grid.Constraints.MinHeight := FreqOutBtn.Top + FreqOutBtn.Height - Grid.Top; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TABCLogLinearFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TABCLogLinearFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TABCLogLinearFrm.FreqInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (FreqVarEdit.Text = '') then + begin + FreqVarEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TABCLogLinearFrm.FreqOutBtnClick(Sender: TObject); +begin + if FreqVarEdit.Text <> '' then + begin + VarList.Items.Add(FreqVarEdit.Text); + FreqVarEdit.Text := ''; + end; +end; + +procedure TABCLogLinearFrm.NColsEditKeyPress(Sender: TObject; var Key: char); +begin + if ord(Key) = 13 then NslicesEdit.SetFocus; +end; + +procedure TABCLogLinearFrm.NRowsEditKeyPress(Sender: TObject; var Key: char); +begin + if ord(Key) = 13 then NcolsEdit.SetFocus; +end; + +procedure TABCLogLinearFrm.NslicesEditKeyPress(Sender: TObject; var Key: char); +var + i, j, k, row : integer; + Nslices, Ncols, Nrows : integer; +begin + if ord(Key) = 13 then + begin + Nrows := StrToInt(NrowsEdit.Text); + Ncols := StrToInt(NcolsEdit.Text); + Nslices := StrToInt(NslicesEdit.Text); + Grid.RowCount := Nrows * Ncols * Nslices + 1; + row := 1; + for k := 1 to Nslices do + begin + for j := 1 to Ncols do + begin + for i := 1 to Nrows do + begin + Grid.Cells[0,row] := IntToStr(i); + Grid.Cells[1,row] := IntToStr(j); + Grid.Cells[2,row] := IntToStr(k); + row := row + 1; + end; + end; + end; + Grid.SetFocus; + end; +end; + +procedure TABCLogLinearFrm.ColInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (ColVarEdit.Text = '') then + begin + ColVarEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TABCLogLinearFrm.ColOutBtnClick(Sender: TObject); +begin + if ColVarEdit.Text <> '' then + begin + VarList.Items.Add(ColVarEdit.Text); + ColVarEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TABCLogLinearFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, row, col, slice, Nrows, Ncols, Nslices : integer; + Data : DblDyneCube; + AB, AC, BC : DblDyneMat; + RowMarg, ColMarg, SliceMarg : DblDyneVec; + Total : double; + arraysize : integer; + Model : integer; + astr, Title : string; + RowCol, ColCol, SliceCol, Fcol : integer; + GridPos : IntDyneVec; + value : integer; + Fx : double; + lReport: TStrings; +begin + if RowVarEdit.Text = '' then + begin + MessageDlg('Row variable is not selected.', mtError, [mbOK], 0); + exit; + end; + if ColVarEdit.Text = '' then + begin + MessageDlg('Column variable is not selected.', mtError, [mbOK], 0); + exit; + end; + if SliceVarEdit.Text = '' then + begin + MessageDlg('Slice variable is not selected.', mtError, [mbOK], 0); + exit; + end; + if FreqVarEdit.Text = '' then + begin + MessageDlg('Frequency variable is not selected.', mtError, [mbOK], 0); + exit; + end; + + Nrows := 0; + Ncols := 0; + Nslices := 0; + Total := 0.0; + + if FileFromGrp.ItemIndex = 0 then // mainfrm input + begin + SetLength(GridPos, 4); + for i := 1 to NoVariables do + begin + if RowVarEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then GridPos[0] := i; + if ColVarEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then GridPos[1] := i; + if SliceVarEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then GridPos[2] := i; + if FreqVarEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then GridPos[3] := i; + end; + + // get no. of rows, columns and slices + for i := 1 to OS3MainFrm.DataGrid.RowCount - 1 do + begin + value := StrToInt(OS3MainFrm.DataGrid.Cells[GridPos[0],i]); + if value > Nrows then Nrows := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[GridPos[1],i]); + if value > Ncols then Ncols := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[GridPos[2],i]); + if value > Nslices then Nslices := value; + end; + + SetLength(AB, Nrows+1, Ncols+1); + SetLength(AC, Nrows+1, Nslices+1); + SetLength(BC, Ncols+1, Nslices+1); + SetLength(Data, Nrows+1, Ncols+1, Nslices+1); + SetLength(RowMarg, Nrows+1); + SetLength(ColMarg, Ncols+1); + SetLength(SliceMarg, Nslices+1); + + for i := 1 to Nrows do + for j := 1 to Ncols do + AB[i,j] := 0.0; + for i := 1 to Nrows do + for k := 1 to Nslices do + AC[i,k] := 0.0; + for j := 1 to Ncols do + for k := 1 to Nslices do + BC[j,k] := 0.0; + + // Get data + arraysize := Nrows * Ncols * Nslices; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Data[i,j,k] := 0.0; + rowcol := GridPos[0]; + colcol := GridPos[1]; + slicecol := GridPos[2]; + Fcol := GridPos[3]; + for i := 1 to OS3MainFrm.DataGrid.RowCount - 1 do + begin + if not GoodRecord(i, 4, GridPos) then continue; + row := StrToInt(OS3MainFrm.DataGrid.Cells[rowcol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[colcol,i]); + slice := StrToInt(OS3MainFrm.DataGrid.Cells[slicecol,i]); + Fx := StrToInt(OS3MainFrm.DataGrid.Cells[Fcol,i]); + Data[row,col,slice] := Data[row,col,slice] + Fx; + Total := Total + Fx; + RowMarg[row] := RowMarg[row] + Fx; + ColMarg[col] := ColMarg[col] + Fx; + SliceMarg[slice] := SliceMarg[slice] + Fx; + AB[row,col] := AB[row,col] + Fx; + AC[row,slice] := AC[row,slice] + Fx; + BC[col,slice] := BC[col,slice] + Fx; + end; + GridPos := nil; + end; + + if FileFromGrp.ItemIndex = 1 then // form input + begin + Nrows := StrToInt(NrowsEdit.Text); + Ncols := StrToInt(NcolsEdit.Text); + Nslices := StrToInt(NslicesEdit.Text); + SetLength(AB, Nrows+1, Ncols+1); + SetLength(AC, Nrows+1, Nslices+1); + SetLength(BC, Ncols+1, Nslices+1); + SetLength(Data, Nrows+1, Ncols+1, Nslices+1); + SetLength(RowMarg, Nrows+1); + SetLength(ColMarg, Ncols+1); + SetLength(SliceMarg, Nslices+1); + + for i := 1 to Nrows do + for j := 1 to Ncols do + AB[i,j] := 0.0; + for i := 1 to Nrows do + for k := 1 to Nslices do + AC[i,k] := 0.0; + for j := 1 to Ncols do + for k := 1 to Nslices do + BC[j,k] := 0.0; + + // get data + arraysize := Nrows * Ncols * Nslices; + for i := 1 to arraysize do + begin + row := StrToInt(Grid.Cells[0,i]); + col := StrToInt(Grid.Cells[1,i]); + slice := StrToInt(Grid.Cells[2,i]); + Data[row,col,slice] := StrToInt(Grid.Cells[3,i]); + AB[row,col] := AB[row,col] + Data[row,col,slice]; + AC[row,slice] := AC[row,slice] + Data[row,col,slice]; + BC[col,slice] := BC[col,slice] + Data[row,col,slice]; + Total := Total + Data[row,col,slice]; + RowMarg[row] := RowMarg[row] + Data[row,col,slice]; + ColMarg[col] := ColMarg[col] + Data[row,col,slice]; + SliceMarg[slice] := SliceMarg[slice] + Data[row,col,slice]; + end; + end; + + // print heading of output + lReport := TStringList.Create; + try + lReport.Add('LOG-LINEAR ANALYSIS OF A THREE DIMENSION TABLE'); + lReport.Add(''); + + // print observed matrix + astr := 'Observed Frequencies'; + lReport.Add(astr); + PrintTable(Nrows,Ncols,Nslices,Data,RowMarg,ColMarg,SliceMarg,Total, lReport); + lReport.Add(''); + + // Print sub-matrices + Title := 'Sub-matrix AB'; + PrintMatrix(AB,Nrows,Ncols,Title, lReport); + Title := 'Sub-matrix AC'; + PrintMatrix(AC,Nrows,Nslices,Title, lReport); + Title := 'Sub-matrix BC'; + PrintMatrix(BC,Ncols,Nslices,Title, lReport); + + DisplayReport(lReport); + lReport.Clear; + + + for Model := 1 to 9 do + ModelEffect(Nrows,Ncols,Nslices,Data,RowMarg,ColMarg, + SliceMarg,AB,AC,BC,Total,Model, lReport); + + finally + lReport.Free; + SliceMarg := nil; + ColMarg := nil; + RowMarg := nil; + Data := nil; + BC := nil; + AC := nil; + AB := nil; + end; +end; + +procedure TABCLogLinearFrm.ModelEffect( + Nrows, Ncols, Nslices: integer; + const Data: DblDyneCube; + const RowMarg, ColMarg, SliceMarg: DblDyneVec; + const AB, AC, BC: DblDyneMat; + var Total: double; + Model: integer; + AReport: TStrings); +var + i, j, k: integer; + CellLambdas : DblDyneQuad; + LogData, Expected : DblDyneCube; + Title, astr : string; + NewRowMarg,NewColMarg,NewSliceMarg : DblDyneVec; + LogRowMarg, LogColMarg, LogSliceMarg : DblDyneVec; + NewTotal : double; + ABLogs, ACLogs, BCLogs : DblDyneMat; + LogTotal, mu, Ysqr : double; + DF : integer; +begin + // Get expected values for chosen model + SetLength(Expected,Nrows+1, Ncols+1, Nslices+1); + SetLength(NewRowMarg, Nrows+1); + SetLength(NewColMarg, Ncols+1); + SetLength(NewSliceMarg, Nslices+1); + SetLength(LogRowMarg, Nrows+1); + SetLength(LogColMarg, Ncols+1); + SetLength(LogSliceMarg, Nslices+1); + SetLength(ABLogs, Nrows+1, Ncols+1); + SetLength(ACLogs, Nrows+1, Nslices+1); + SetLength(BCLogs, Ncols+1, Nslices+1); + SetLength(LogData, Nrows+1, Ncols+1, Nslices+1); + SetLength(CellLambdas, Nrows+1, Ncols+1, Nslices+1, 8); + + if Model = 1 then // Saturated model + begin + Title := 'Saturated Model'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := Data[i,j,k]; + end; + + if Model = 2 then // independence + begin + Title := 'Model of Independence'; + Iterate(Nrows, Ncols, Nslices, Data, RowMarg, ColMarg, SliceMarg, + Total, Expected, NewRowMarg, NewColMarg, NewSliceMarg, NewTotal); + end; + + if Model = 3 then // no AB effect + begin + Title := 'No AB Effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := AC[i,k] * BC[j,k] / SliceMarg[k]; + end; + if Model = 4 then // no AC effect + begin + Title := 'No AC Effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := AB[i,j] * BC[j,k] / ColMarg[j]; + end; + if Model = 5 then // no BC effect + begin + Title := 'No BC Effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := AB[i,j] * AC[i,k] / RowMarg[i]; + end; + if Model = 6 then // no C effect + begin + Title := 'Model of No Slice (C) effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := (RowMarg[i] / Total) * + (ColMarg[j] / Total) * (Total / Nslices); + end; + + if Model = 7 then // no B effect + begin + Title := 'Model of no Column (B) effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := (RowMarg[i] / Total) * + (SliceMarg[k] / Total) * (Total / Ncols); + end; + + if Model = 8 then // no A effect + begin + Title := 'Model of no Row (A) effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := (ColMarg[j] / Total) * + (SliceMarg[k] / Total) * (Total / Nrows); + end; + + if Model = 9 then // Equiprobability Model + begin + Title := 'Equi-probability Model'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := Total / + (Nrows * NCols * Nslices); + end; + LogTotal := 0.0; + for i := 1 to Nrows do + begin + NewRowMarg[i] := 0.0; + LogRowMarg[i] := 0.0; + end; + for j := 1 to Ncols do + begin + NewColMarg[j] := 0.0; + LogColMarg[j] := 0.0; + end; + for k := 1 to Nslices do + begin + NewSliceMarg[k] := 0.0; + LogSliceMarg[k] := 0.0; + end; + + for i := 1 to Nrows do + for j := 1 to Ncols do + ABLogs[i,j] := 0.0; + + for i := 1 to Nrows do + for k := 1 to Nslices do + ACLogs[i,k] := 0.0; + + for j := 1 to Ncols do + for k := 1 to Nslices do + BCLogs[j,k] := 0.0; + + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + NewRowMarg[i] := NewRowMarg[i] + Expected[i,j,k]; + NewColMarg[j] := NewColMarg[j] + Expected[i,j,k]; + NewSliceMarg[k] := NewSliceMarg[k] + Expected[i,j,k]; + end; + end; + end; + + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + LogData[i,j,k] := ln(Expected[i,j,k]); + + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + LogRowMarg[i] := LogRowMarg[i] + LogData[i,j,k]; + LogColMarg[j] := LogColMarg[j] + LogData[i,j,k]; + LogSliceMarg[k] := LogSliceMarg[k] + LogData[i,j,k]; + ABLogs[i,j] := ABLogs[i,j] + LogData[i,j,k]; + ACLogs[i,k] := ACLogs[i,k] + LogData[i,j,k]; + BCLogs[j,k] := BCLogs[j,k] + LogData[i,j,k]; + LogTotal := LogTotal + LogData[i,j,k]; + end; + end; + end; + + for i := 1 to Nrows do LogRowMarg[i] := LogRowMarg[i] / (Ncols * Nslices); + for j := 1 to Ncols do LogColMarg[j] := LogColMarg[j] / (Nrows * Nslices); + for k := 1 to Nslices do LogSliceMarg[k] := LogSliceMarg[k] / (Ncols * Nrows); + LogTotal := LogTotal / (Ncols * Nrows * Nslices); + for i := 1 to Nrows do + for j := 1 to Ncols do + ABLogs[i,j] := ABLogs[i,j] / Nslices; + for i := 1 to Nrows do + for k := 1 to Nslices do + ACLogs[i,k] := ACLogs[i,k] / Ncols; + for j := 1 to Ncols do + for k := 1 to Nslices do + BCLogs[j,k] := BCLogs[j,k] / Nrows; + + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + CellLambdas[i,j,k,1] := LogRowMarg[i] - LogTotal; + CellLambdas[i,j,k,2] := LogColMarg[j] - LogTotal; + CellLambdas[i,j,k,3] := LogSliceMarg[k] - LogTotal; + CellLambdas[i,j,k,4] := ABLogs[i,j] - LogRowMarg[i] + - LogColMarg[j] + LogTotal; + CellLambdas[i,j,k,5] := ACLogs[i,k] - LogRowMarg[i] + - LogSliceMarg[k] + LogTotal; + CellLambdas[i,j,k,6] := BCLogs[j,k] - LogColMarg[j] + - LogSliceMarg[k] + LogTotal; + CellLambdas[i,j,k,7] := LogData[i,j,k] + LogRowMarg[i] + + LogColMarg[j] + LogSliceMarg[k] + - ABLogs[i,j] - ACLogs[i,k] + - BCLogs[j,k] - LogTotal; + end; + end; + end; + mu := LogTotal; + + // Get Y square for model + Ysqr := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Ysqr := Ysqr + (Data[i,j,k] * ln(Data[i,j,k] / Expected[i,j,k])); + Ysqr := 2.0 * Ysqr; + + AReport.Add(Title); + AReport.Add(''); + + astr := 'Expected Frequencies'; + AReport.Add(astr); + PrintTable(Nrows,Ncols,Nslices,Expected,NewRowMarg,NewColMarg, + NewSliceMarg,NewTotal, AReport); + AReport.Add(''); + + astr := 'Log Frequencies'; + AReport.Add(astr); + PrintTable(Nrows,Ncols,Nslices,LogData,LogRowMarg,LogColMarg,LogSliceMarg,LogTotal, AReport); + + AReport.Add(''); + AReport.Add('======================================================================'); + AReport.Add(''); + + astr := 'Cell Parameters'; + AReport.Add(astr); + PrintLamdas(Nrows,Ncols,Nslices,CellLambdas, mu, AReport); + AReport.Add(''); + + astr := 'G squared statistic for model fit = ' + format('%6.3f',[Ysqr]); + case Model of + 1 : DF := 0; // saturated + 2 : DF := Nrows * Ncols * Nslices - Nrows - Ncols - Nslices + 2; // independence + 3 : DF := Nslices * (Nrows - 1) * (Ncols - 1); //no AB effect + 4 : DF := Ncols * (Nrows - 1) * (Nslices - 1); // no AC effect + 5 : DF := Nrows * (Ncols - 1) * (Nslices - 1); // no BC effect + 6 : DF := Nrows * Ncols * Nslices - Nrows - Ncols + 1; // no C effect + 7 : DF := Nrows * Ncols * Nslices - Nrows - Nslices + 1; // no B effect + 8 : DF := Nrows * Ncols * Nslices - Ncols - Nslices + 1; // no A effect + 9 : DF := Nrows * Ncols * Nslices - 1; // Equiprobability + end; + astr := astr + ' D.F. = ' + IntToStr(DF); + AReport.Add(astr); + + AReport.Add(''); + AReport.Add('======================================================================'); + AReport.Add(''); + + CellLambdas := nil; + LogData := nil; + BCLogs := nil; + ACLogs := nil; + ABLogs := nil; + LogSliceMarg := nil; + LogColMarg := nil; + LogRowMarg := nil; + NewSliceMarg := nil; + NewColMarg := nil; + NewRowMarg := nil; + Expected := nil; +end; +//------------------------------------------------------------------- + +procedure TABCLogLinearFrm.Iterate( + Nrows, Ncols, Nslices: integer; + const Data: DblDyneCube; const RowMarg, ColMarg, SliceMarg: DblDyneVec; + var Total: double; + const Expected: DblDyneCube; const NewRowMarg, NewColMarg, NewSliceMarg: DblDyneVec; + var NewTotal: double); + +Label Step; +var + Aprevious : DblDyneCube; + i, j, k : integer; + delta : double; + difference : double; + +begin + SetLength(Aprevious,Nrows+1,Ncols+1,Nslices+1); + delta := 0.1; + difference := 0.0; + for i := 1 to Nrows do newrowmarg[i] := 0.0; + for j := 1 to Ncols do newcolmarg[j] := 0.0; + for k := 1 to Nslices do newslicemarg[k] := 0.0; + + // initialize expected values + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + expected[i,j,k] := 1.0; + Aprevious[i,j,k] := 1.0; + end; + end; + end; + +Step: + // step 1: initialize new row margins and calculate expected value + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + newrowmarg[i] := newrowmarg[i] + expected[i,j,k]; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + expected[i,j,k] := (RowMarg[i] / newrowmarg[i]) * expected[i,j,k]; + + // step 2: initialize new col margins and calculate expected values + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + newcolmarg[j] := newcolmarg[j] + expected[i,j,k]; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + expected[i,j,k] := (ColMarg[j] / newcolmarg[j]) * expected[i,j,k]; + + // step 3: initialize new slice margins and calculate expected values + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + newslicemarg[k] := newslicemarg[k] + expected[i,j,k]; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + expected[i,j,k] := (SliceMarg[k] / newslicemarg[k]) * expected[i,j,k]; + + // step 4: check for change and quit if smaller than delta + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + if abs(APrevious[i,j,k]-expected[i,j,k]) > difference then + difference := abs(APrevious[i,j,k]-expected[i,j,k]); + + if difference < delta then + begin + newtotal := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + newtotal := newtotal + expected[i,j,k]; + exit; + end + else begin + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + APrevious[i,j,k] := expected[i,j,k]; + for i := 1 to Nrows do newrowmarg[i] := 0.0; + for j := 1 to Ncols do newcolmarg[j] := 0.0; + for k := 1 to Nslices do newslicemarg[k] := 0.0; + difference := 0.0; + goto step; + end; + Aprevious := nil; +end; +//------------------------------------------------------------------- + +procedure TABCLogLinearFrm.PrintTable( + Nrows, Ncols, Nslices: integer; + const Data: DblDyneCube; const RowMarg, ColMarg, SliceMarg: DblDyneVec; + Total: double; + AReport: TStrings); +var + i, j, k: integer; +begin + AReport.Add(' A B C VALUE '); + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + AReport.Add('%3d %3d %3d %8.3f', [i, j, k, Data[i,j,k]]); + + AReport.Add('Totals for Dimension A'); + for i := 1 to Nrows do + AReport.Add('Row %d %8.3f', [i, RowMarg[i]]); + + AReport.Add('Totals for Dimension B'); + for j := 1 to Ncols do + AReport.Add('Col %d %8.3f', [j, ColMarg[j]]); + + AReport.Add('Totals for Dimension C'); + for k := 1 to Nslices do + AReport.Add('Slice %d %8.3f', [k, SliceMarg[k]]); +end; +//------------------------------------------------------------------- + +procedure TABCLogLinearFrm.PrintLamdas(Nrows, Ncols, Nslices: integer; + const CellLambdas: DblDyneQuad; mu: Double; AReport: TStrings); +var + i, j, k, l: integer; + astr: string; +begin + AReport.Add('ROW COL SLICE MU LAMBDA A LAMBDA B LAMBDA C'); + AReport.Add(' LAMBDA AB LAMBDA AC LAMBDA BC LAMBDA ABC'); + AReport.Add(''); + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + begin + astr := Format('%3d %3d %3d %8.3f ', [i, j, k, mu]); + for l := 1 to 3 do + astr := astr + Format(' %8.3f ', [CellLambdas[i, j, k, l]]); + AReport.Add(astr); + astr := ' '; + for l := 4 to 7 do + astr := astr + format(' %8.3f ', [CellLambdas[i, j, k, l]]); + AReport.Add(astr); + AReport.Add(''); + end; +end; +//------------------------------------------------------------------- + +procedure TABCLogLinearFrm.PrintMatrix(const X: DblDyneMat; + Nrows, Ncols: integer; Title: string; AReport: TStrings); +Label loop; +var + i, j: integer; + first, last: integer; + astr: string; + +begin + AReport.Add(Title); + AReport.Add(''); + + first := 1; + last := Ncols; + if last > 6 then last := 6; + +loop: + astr := 'ROW/COL'; + for j := first to last do + astr := astr + Format(' %3d ', [j]); + AReport.Add(astr); + + for i := 1 to Nrows do + begin + astr := format(' %3d ',[i]); + for j := first to last do astr := astr + Format(' %8.3f ', [X[i,j]]); + AReport.Add(astr); + end; + + if last < Ncols then + begin + first := last + 1; + last := Ncols; + if last > 6 then last := 6; + goto loop; + end; + + AReport.Add(''); +end; + +procedure TABCLogLinearFrm.UpdateBtnStates; +begin + RowInBtn.Enabled := (VarList.ItemIndex > -1) and (RowVarEdit.Text = ''); + RowOutBtn.Enabled := (RowVarEdit.Text <> ''); + ColInBtn.Enabled := (VarList.ItemIndex > -1) and (ColVarEdit.Text = ''); + ColOutBtn.Enabled := (ColVarEdit.Text <> ''); + SliceBtnIn.Enabled := (VarList.ItemIndex > -1) and (SliceVarEdit.Text = ''); + SliceBtnOut.Enabled := (SliceVarEdit.Text <> ''); + FreqInBtn.Enabled := (Varlist.ItemIndex > -1) and (FreqVarEdit.Text = ''); + FreqOutBtn.Enabled := (FreqVarEdit.Text <> ''); +end; + +initialization + {$I abcloglinunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.lfm b/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.lfm new file mode 100644 index 000000000..b273e8d80 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.lfm @@ -0,0 +1,449 @@ +object LogLinScreenFrm: TLogLinScreenFrm + Left = 456 + Height = 584 + Top = 135 + Width = 402 + AutoSize = True + Caption = 'Cross-Classification Log Linear Screen' + ClientHeight = 584 + ClientWidth = 402 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = CountVarChk + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 39 + Width = 337 + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + Caption = '1. Select the variables of the Grid that define your classifications' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 208 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + Caption = 'Available Variables' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = SelectList + AnchorSideTop.Control = Label2 + Left = 232 + Height = 15 + Top = 208 + Width = 44 + Caption = 'Selected' + ParentColor = False + end + object CountVarChk: TCheckBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 19 + Top = 8 + Width = 247 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Last Variable Selected is a Frequency Count' + TabOrder = 0 + end + object Step2Btn: TButton + AnchorSideLeft.Control = Label10 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label10 + AnchorSideTop.Side = asrCenter + Left = 234 + Height = 25 + Top = 55 + Width = 52 + AutoSize = True + BorderSpacing.Left = 16 + Caption = 'Click' + OnClick = Step2BtnClick + TabOrder = 1 + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 230 + Top = 225 + Width = 162 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + TabOrder = 3 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 187 + Height = 28 + Top = 225 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 4 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 187 + Height = 28 + Top = 257 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 5 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = OutBtn + AnchorSideTop.Side = asrBottom + Left = 178 + Height = 25 + Top = 289 + Width = 46 + AutoSize = True + BorderSpacing.Top = 4 + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 6 + end + object SelectList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 232 + Height = 230 + Top = 225 + Width = 162 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 7 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label11 + AnchorSideTop.Side = asrBottom + Left = 24 + Height = 85 + Top = 111 + Width = 244 + AutoSize = True + BorderSpacing.Left = 24 + BevelOuter = bvNone + ClientHeight = 85 + ClientWidth = 244 + TabOrder = 2 + object Label7: TLabel + AnchorSideTop.Control = VarNoEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = VarNoEdit + Left = 137 + Height = 15 + Top = 12 + Width = 44 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Variable:' + ParentColor = False + end + object Label8: TLabel + AnchorSideTop.Control = MinEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = MinEdit + Left = 98 + Height = 15 + Top = 39 + Width = 87 + Anchors = [akTop, akRight] + BorderSpacing.Right = 4 + Caption = 'Minimum Value:' + ParentColor = False + end + object Label9: TLabel + AnchorSideTop.Control = MaxEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = MaxEdit + Left = 92 + Height = 15 + Top = 66 + Width = 89 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Maximum Value:' + ParentColor = False + end + object ScrollBar1: TScrollBar + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = VarNoEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label7 + Left = 0 + Height = 17 + Top = 11 + Width = 121 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Right = 16 + PageSize = 0 + TabOrder = 0 + OnChange = ScrollBar1Change + end + object VarNoEdit: TEdit + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 189 + Height = 23 + Top = 8 + Width = 55 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + TabOrder = 1 + Text = 'VarNoEdit' + end + object MinEdit: TEdit + AnchorSideLeft.Control = VarNoEdit + AnchorSideTop.Control = VarNoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 189 + Height = 23 + Top = 35 + Width = 55 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + OnKeyPress = MinEditKeyPress + TabOrder = 2 + Text = 'MinEdit' + end + object MaxEdit: TEdit + AnchorSideLeft.Control = VarNoEdit + AnchorSideTop.Control = MinEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 189 + Height = 23 + Top = 62 + Width = 55 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + OnKeyPress = MaxEditKeyPress + TabOrder = 3 + Text = 'MaxEdit' + end + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 72 + Top = 463 + Width = 241 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 237 + TabOrder = 8 + object MarginsChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 213 + Caption = 'Print Marginal Totals' + TabOrder = 0 + end + object GenlModelChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 213 + Caption = 'Print General Linear Modle Estimates' + TabOrder = 1 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 101 + Height = 25 + Top = 551 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 10 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 167 + Height = 25 + Top = 551 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 11 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 241 + Height = 25 + Top = 551 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 12 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 329 + Height = 25 + Top = 551 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 13 + end + object HelpBtn: TButton + Tag = 131 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 38 + Height = 25 + Top = 551 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 9 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 535 + Width = 402 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Label10: TLabel + AnchorSideLeft.Control = Label1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 60 + Width = 210 + BorderSpacing.Top = 6 + Caption = '2. Click here when variables are selected' + ParentColor = False + end + object Label11: TLabel + AnchorSideTop.Control = Label10 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 30 + Top = 81 + Width = 386 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 6 + BorderSpacing.Right = 8 + Caption = '3. For each variable complete the specifications below. Press the ENTER key following each entry.' + ParentColor = False + WordWrap = True + end +end diff --git a/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.pas b/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.pas new file mode 100644 index 000000000..6141bfd94 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.pas @@ -0,0 +1,1172 @@ +unit LogLinScreenUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + Globals, MainUnit, FunctionsLib, OutputUnit, DataProcs, ContextHelpUnit; + +type + + { TLogLinScreenFrm } + + TLogLinScreenFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + InBtn: TBitBtn; + Label10: TLabel; + Label11: TLabel; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + MarginsChk: TCheckBox; + GenlModelChk: TCheckBox; + GroupBox1: TGroupBox; + MaxEdit: TEdit; + MinEdit: TEdit; + Label8: TLabel; + Label9: TLabel; + VarNoEdit: TEdit; + Label2: TLabel; + Label3: TLabel; + Label7: TLabel; + Panel1: TPanel; + ScrollBar1: TScrollBar; + SelectList: TListBox; + VarList: TListBox; + Step2Btn: TButton; + CountVarChk: TCheckBox; + Label1: TLabel; + procedure AllBtnClick(Sender: TObject); + procedure CancelBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure MaxEditKeyPress(Sender: TObject; var Key: char); + procedure MinEditKeyPress(Sender: TObject; var Key: char); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure ScrollBar1Change(Sender: TObject); + procedure Step2BtnClick(Sender: TObject); + function ArrayPosition(Sender: TObject; NoDims : integer; + VAR Data : DblDyneVec; + VAR Subscripts : IntDyneVec; + VAR DimSize : IntDyneVec) : integer; + procedure Marginals(Sender: TObject; + NoDims : integer; + ArraySize : integer; + VAR Indexes : IntDyneMat; + VAR Data : DblDyneVec; + VAR Margins : IntDyneMat); + + private + { private declarations } + FAutoSized: Boolean; + procedure Screen(VAR NVAR : integer; + VAR MP : integer; VAR MM : integer; + VAR NTAB : integer; VAR TABLE : DblDyneVec; + VAR DIM : IntDyneVec; VAR GSQ : DblDyneVec; + VAR DGFR : IntDyneVec; VAR PART : DblDyneMat; + VAR MARG : DblDyneMat; VAR DFS : IntDyneMat; + VAR IP : IntDyneMat; VAR IM : IntDyneMat; + VAR ISET : IntDyneVec; VAR JSET : IntDyneVec; + VAR CONFIG : IntDyneMat; VAR FIT : DblDyneVec; + VAR SIZE : IntDyneVec; VAR COORD : IntDyneVec; + VAR X : DblDyneVec; VAR Y : DblDyneVec; + VAR IFAULT : integer); + + procedure CONF(VAR N : integer; VAR M : integer; + VAR MP : integer; + VAR MM : integer; + VAR ISET : IntDyneVec; VAR JSET : IntDyneVec; + VAR IP : IntDyneMat; VAR IM : IntDyneMat; VAR NP : integer); + + procedure COMBO(VAR ISET : IntDyneVec; + N, M : Integer; + VAR LAST : boolean); + + procedure EVAL(VAR IAR : IntDyneMat; + NC, NV, IBEG, NVAR, MAX : integer; + VAR CONFIG : IntDyneMat; + VAR DIM : IntDyneVec; VAR DF : integer); + + procedure RESET(VAR FIT : DblDyneVec; NTAB : Integer; + AVG : Double); + + procedure LIKE(VAR GSQ : Double; VAR FIT : DblDyneVec; + VAR TABLE : DblDyneVec; NTAB : integer); + + procedure LOGFIT(NVAR, NTAB, NCON : integer; + VAR DIM : IntDyneVec; + VAR CONFIG : IntDyneMat; VAR TABLE : DblDyneVec; + VAR FIT : DblDyneVec; VAR SIZE : IntDyneVec; + VAR COORD : IntDyneVec; VAR X : DblDyneVec; + VAR Y : DblDyneVec); + + procedure MaxCombos(NoDims : integer; VAR MM : integer; VAR MP : integer); + + public + { public declarations } + end; + +var + LogLinScreenFrm: TLogLinScreenFrm; + Minimums : IntDyneVec; + Maximums : IntDyneVec; + Response : BoolDyneVec; + Interact : BoolDyneVec; + NoDims : integer; + +implementation + +uses + Math; + +{ TLogLinScreenFrm } + +procedure TLogLinScreenFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + Panel1.Visible := false; + VarList.Clear; + SelectList.Clear; + VarNoEdit.Text := '1'; + MaxEdit.Text := ''; + MinEdit.Text := ''; + InBtn.Enabled := true; + OutBtn.Enabled := false; + NoDims := 0; + Minimums := nil; + Maximums := nil; + Response := nil; + Interact := nil; + ScrollBar1.Min := 1; + ScrollBar1.Max := 1; + ScrollBar1.Position := 1; + for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TLogLinScreenFrm.ReturnBtnClick(Sender: TObject); +begin + Maximums := nil; + Minimums := nil; + Response := nil; + Interact := nil; + Close; +end; + +procedure TLogLinScreenFrm.ScrollBar1Change(Sender: TObject); +begin + VarNoEdit.Text := IntToStr(ScrollBar1.Position); +end; + +procedure TLogLinScreenFrm.Step2BtnClick(Sender: TObject); +begin + if CountVarChk.Checked then + begin + NoDims := NoDims - 1; + ScrollBar1.Max := NoDims; + end; + Panel1.Visible := true; + setLength(Maximums,NoDims); + SetLength(Minimums,NoDims); + SetLength(Response,NoDims); + SetLength(Interact,NoDims); + MaxEdit.SetFocus; +end; + +procedure TLogLinScreenFrm.InBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + SelectList.Items.Add(VarList.Items.Strings[index]); + VarList.Items.Delete(index); + OutBtn.Enabled := true; + NoDims := NoDims + 1; + ScrollBar1.Max := NoDims; + index := VarList.Items.Count; + if index <= 0 then InBtn.Enabled := false; +end; + +procedure TLogLinScreenFrm.MaxEditKeyPress(Sender: TObject; var Key: char); +VAR DimNo : integer; +begin + if ord(Key) = 13 then // return key + begin + DimNo := StrToInt(VarNoEdit.Text); + Maximums[DimNo-1] := StrToInt(MaxEdit.Text); + ScrollBar1.SetFocus; + end; +end; + +procedure TLogLinScreenFrm.MinEditKeyPress(Sender: TObject; var Key: char); +VAR DimNo : integer; +begin + if ord(Key) = 13 then // return key + begin + DimNo := StrToInt(VarNoEdit.Text); + Minimums[DimNo-1] := StrToInt(MinEdit.Text); + MaxEdit.SetFocus; + end; +end; + +procedure TLogLinScreenFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TLogLinScreenFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TLogLinScreenFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TLogLinScreenFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TLogLinScreenFrm.CancelBtnClick(Sender: TObject); +begin + Maximums := nil; + Minimums := nil; + Response := nil; + Interact := nil; + Close; +end; + +procedure TLogLinScreenFrm.AllBtnClick(Sender: TObject); +VAR i, count : integer; +begin + count := VarList.Items.Count; + for i := 0 to count-1 do + SelectList.Items.Add(VarList.Items.Strings[i]); + InBtn.Enabled := false; + OutBtn.Enabled := true; + NoDims := SelectList.Items.Count; + ScrollBar1.Max := NoDims; +end; + +procedure TLogLinScreenFrm.ComputeBtnClick(Sender: TObject); +var + ArraySize : integer; + N : integer; + index, index2, i, j, k, l, NoVars : integer; + count : integer; + Data : DblDyneVec; + Subscripts : IntDyneVec; + DimSize : IntDyneVec; + GridPos : IntDyneVec; + Labels : StrDyneVec; + Margins : IntDyneMat; + Expected : DblDyneVec; + WorkVec : IntDyneVec; + Indexes : IntDyneMat; + LogM : DblDyneVec; + NSize : IntDyneVec; + M : DblDyneMat; + astr, HeadStr : string; + MaxDim, MP, MM : integer; + U, Mu : Double; + Chi2, G2 : double; + DF : integer; + ProbChi2, ProbG2 : double; + GSQ : DblDyneVec; + DGFR : IntDyneVec; + PART : DblDyneMat; + MARG : DblDyneMat; + DFS : IntDyneMat; + IP : IntDyneMat; + IM : IntDyneMat; + ISET : IntDyneVec; + JSET : IntDyneVec; + CONFIG : IntDyneMat; + FIT : DblDyneVec; + SIZE : IntDyneVec; + COORD : IntDyneVec; + X, Y : DblDyneVec; + IFAULT : integer; + TABLE : DblDyneVec; + DIM : IntDyneVec; +begin + OutputFrm.RichEdit.Clear; + + // Allocate space for labels, DimSize and SubScripts + NoVars := SelectList.Items.Count; + SetLength(Labels,NoVars); + SetLength(DimSize,NoDims); + SetLength(Subscripts,NoDims); + SetLength(GridPos,NoVars); + + // get variable labels and column positions + for i := 1 to NoVars do + begin + astr := SelectList.Items.Strings[i-1]; + for j := 1 to NoVariables do + begin + if OS3MainFrm.DataGrid.Cells[j,0] = astr then + begin + Labels[i-1] := astr; + GridPos[i-1] := j; + break; + end; + end; + end; + + // Get no. of categories for each dimension (DimSize) + MaxDim := 0; + ArraySize := 1; + for i := 0 to NoDims - 1 do + begin + DimSize[i] := Maximums[i] - Minimums[i] + 1; + if DimSize[i] > MaxDim then MaxDim := DimSize[i]; + ArraySize := ArraySize * DimSize[i]; + end; + + // Allocate space for Data and marginals + SetLength(WorkVec,MaxDim); + SetLength(Data,ArraySize); + SetLength(Margins,NoDims,MaxDim); + SetLength(Expected,ArraySize); + SetLength(Indexes,ArraySize+1,NoDims); + SetLength(LogM,ArraySize); + SetLength(M,ArraySize,NoDims); + SetLength(NSize,NoDims); + + // Initialize data and margins arrays + for i := 1 to NoDims do + for j := 1 to MaxDim do + Margins[i-1,j-1] := 0; + for i := 1 to ArraySize do Data[i-1] := 0; + N := 0; + + // Read and store frequencies in Data + for i := 1 to NoCases do + begin + if GoodRecord(i, NoVars, GridPos) then // casewise check + begin + for j := 1 to NoDims do // get cell subscripts + begin + index := StrToInt(OS3MainFrm.DataGrid.Cells[GridPos[j-1],i]); + index := index - Minimums[j-1] + 1; + Subscripts[j-1] := index; + end; + + index := ArrayPosition(Self, NoDims, Data, Subscripts, DimSize); + + for j := 1 to NoDims do // save subscripts for later use + Indexes[index,j-1] := Subscripts[j-1]; + + if CountVarChk.Checked then + begin + k := GridPos[NoVars-1]; + Data[index] := Data[index] + StrToInt(OS3MainFrm.DataGrid.Cells[k,i]); + end + else Data[index] := Data[index] + 1; + end; + end; + + // get total N + for i := 1 to ArraySize do N := N + Round(Data[i-1]); + + // Get marginal frequencies + Marginals(Self,NoDims,ArraySize,Indexes,Data,Margins); + + // Print Marginal totals if requested + if MarginsChk.Checked then + begin + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('FILE: '+ OS3MainFrm.FileNameEdit.Text); + OutputFrm.RichEdit.Lines.Add(''); + for i := 1 to NoDims do + begin + HeadStr := 'Marginal Totals for ' + Labels[i-1]; + k := DimSize[i-1]; + for j := 0 to k-1 do WorkVec[j] := Margins[i-1,j]; + VecPrint(WorkVec,k,HeadStr); + end; + end; + OutputFrm.RichEdit.Lines.Add(''); + astr := Format('Total Frequencies = %d',[N]); + OutputFrm.RichEdit.Lines.Add(astr); + OutputFrm.ShowModal; + + // Get Expected cell values + U := 0.0; // overall mean (mu) of log linear model + for i := 1 to ArraySize do // indexes point to each cell + begin + Expected[i-1] := 1.0; + for j := 1 to NoDims do + begin + k := Indexes[i-1,j-1]; + Expected[i-1] := Expected[i-1] * (Margins[j-1,k-1] / N); + end; + Expected[i-1] := Expected[i-1] * N; + LogM[i-1] := ln(Expected[i-1]); + end; + for i := 1 to ArraySize do U := U + LogM[i-1]; + U := U / ArraySize; + + // print expected values + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('FILE: '+ OS3MainFrm.FileNameEdit.Text); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('EXPECTED CELL VALUES FOR MODEL OF COMPLETE INDEPENDENCE'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Cell Observed Expected Log Expected'); + for i := 1 to ArraySize do + begin + astr := ''; + for j := 1 to NoDims do astr := astr + format('%3d ',[Indexes[i-1,j-1]]); + astr := astr + format('%10.0f %10.2f %10.3f',[Data[i-1],Expected[i-1],LogM[i-1]]); + OutputFrm.RichEdit.Lines.Add(astr); + end; + chi2 := 0.0; + G2 := 0.0; + + // Calculate chi-squared and G squared statistics + for i := 1 to ArraySize do + begin + chi2 := chi2 + Sqr(Data[i-1] - Expected[i-1]) / Expected[i-1]; + G2 := G2 + Data[i-1] * ln(Data[i-1] / Expected[i-1]); + end; + G2 := 2.0 * G2; + DF := 1; + for i := 1 to NoDims do DF := DF * (DimSize[i-1]-1); + ProbChi2 := 1.0 - Chisquaredprob(chi2,DF); + ProbG2 := 1.0 - Chisquaredprob(G2,DF); + astr := format('Chisquare = %10.3f with probability = %10.3f (DF = %d)',[chi2,ProbChi2,DF]); + OutputFrm.RichEdit.Lines.Add(astr); + astr := format('G squared = %10.3f with probability = %10.3f (DF = %d)',[G2,ProbG2,DF]); + OutputFrm.RichEdit.Lines.Add(astr); + OutputFrm.RichEdit.Lines.Add(''); + astr := format('U (mu) for general loglinear model = %10.2f',[U]); + OutputFrm.RichEdit.Lines.Add(astr); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.ShowModal; + + // Get log linear model values for each cell + // get M's for each cell + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('First Order LogLinear Model Factors and N of Cells in Each'); + astr := 'CELL '; + for i := 1 to NoDims do astr := astr + format(' U%d N Cells ',[i]); + OutputFrm.RichEdit.Lines.Add(astr); + OutputFrm.RichEdit.Lines.Add(''); + for i := 1 to ArraySize do // cell + begin + astr := ''; + for j := 1 to NoDims do + astr := astr + format('%3d ',[Indexes[i-1,j-1]]); + for j := 1 to NoDims do // jth mu + begin + index := Indexes[i-1,j-1]; // sum for this mu + count := 0; + Mu := 0.0; + for k := 1 to ArraySize do + begin + if index = Indexes[k-1,j-1] then + begin + count := count + 1; + Mu := Mu + LogM[k-1]; + end; + end; + Mu := Mu / count - U; + astr := astr + format('%10.3f %3d ',[Mu,count]); + end; + OutputFrm.RichEdit.Lines.Add(astr); + end; + OutputFrm.ShowModal; + + // get second order interactions + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Second Order Loglinear Model Terms and N of Cells in Each'); + astr := 'CELL '; + for i := 1 to NoDims-1 do + for j := i + 1 to NoDims do + astr := astr + format('U%d%d N Cells ',[i,j]); + OutputFrm.RichEdit.Lines.Add(astr); + OutputFrm.RichEdit.Lines.Add(''); + for i := 1 to ArraySize do // cell + begin + astr := ''; + for j := 1 to NoDims do + astr := astr + format('%3d ',[Indexes[i-1,j-1]]); + for j := 1 to NoDims-1 do // jth + begin + index := Indexes[i-1,j-1]; // sum for this mu using j and k + for k := j+1 to NoDims do // with kth + begin + index2 := Indexes[i-1,k-1]; + Mu := 0.0; + count := 0; + for l := 1 to ArraySize do + begin + if ((index = Indexes[l-1,j-1]) and (index2 = Indexes[l-1,k-1])) then + begin + Mu := Mu + LogM[l-1]; + count := count + 1; + end; + end; // next l + Mu := Mu / count - U; + astr := astr + format('%10.3f %3d',[Mu,count]); + end; // next k (second term subscript) + end; // next j (first term subscript) + OutputFrm.RichEdit.Lines.Add(astr); + end; // next i + + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // get maximum no. of interactions in saturated model + MaxCombos(NoDims, MM, MP); + + SetLength(GSQ,NoDims+1); + SetLength(DGFR,NoDims+1); + SetLength(PART,NoDims+1,MP+1); + SetLength(MARG,NoDims+1,MP+1); + SetLength(DFS,NoDims+1,MP+1); + SetLength(IP,NoDims+1,MP+1); + SetLength(IM,NoDims+1,MM+1); + SetLength(ISET,NoDims+1); + SetLength(JSET,NoDims+1); + SetLength(CONFIG,NoDims+1,MP+1); + SetLength(FIT,ArraySize+1); + SetLength(SIZE,NoDims+1); + SetLength(COORD,NoDims+1); + SetLength(X,ArraySize+1); + SetLength(Y,ArraySize+1); + SetLength(TABLE,ArraySize+1); + SetLength(DIM,NoDims+1); + + // Load TABLE and DIM one up from Data + for i := 1 to ArraySize do Table[i] := Data[i-1]; + for i := 1 to NoDims do DIM[i] := DimSize[i-1]; + + Screen(NoDims,MP,MM,ArraySize,TABLE,DIM, + GSQ,DGFR,PART,MARG,DFS,IP,IM,ISET,JSET,CONFIG,FIT,SIZE, + COORD,X,Y,IFAULT); + + // show results + astr := 'SCREEN FOR INTERACTIONS AMONG THE VARIABLES'; + OutputFrm.RichEdit.Lines.Add(astr); + astr := 'Adapted from the Fortran program by Lustbader and Stodola printed in'; + OutputFrm.RichEdit.Lines.Add(astr); + astr := 'Applied Statistics, Volume 30, Issue 1, 1981, pages 97-105 as Algorithm'; + OutputFrm.RichEdit.Lines.Add(astr); + astr := 'AS 160 Partial and Marginal Association in Multidimensional Contingency Tables'; + OutputFrm.RichEdit.Lines.Add(astr); + OutputFrm.RichEdit.Lines.Add(''); + astr := 'Statistics for tests that the interactions of a given order are zero'; + OutputFrm.RichEdit.Lines.Add(astr); + astr := 'ORDER STATISTIC D.F. PROB.'; + OutputFrm.RichEdit.Lines.Add(astr); + for i := 1 to NoDims do + begin + ProbChi2 := 1.0 - ChiSquaredProb(GSQ[i],DGFR[i]); + astr := format('%5d %10.3f %3d %10.3f',[i,GSQ[i],DGFR[i],ProbChi2]); + OutputFrm.RichEdit.Lines.Add(astr); + end; + OutputFrm.RichEdit.Lines.Add(''); + astr := 'Statistics for Marginal Association Tests'; + OutputFrm.RichEdit.Lines.Add(astr); + astr := 'VARIABLE ASSOC. PART ASSOC. MARGINAL ASSOC. D.F. PROB'; + OutputFrm.RichEdit.Lines.Add(astr); + for i := 1 to NoDims-1 do + begin + for j := 1 to MP do + begin + ProbChi2 := 1.0 - ChiSquaredProb(MARG[i,j],DFS[i,j]); + astr := format('%5d %5d %10.3f %10.3f %3d %10.3f', + [i,j,Part[i,j],MARG[i,j], DFS[i,j],ProbChi2]); + OutputFrm.RichEdit.Lines.Add(astr); + end; + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + TABLE := nil; + DIM := nil; + Y := nil; + X := nil; + COORD := nil; + SIZE := nil; + FIT := nil; + CONFIG := nil; + JSET := nil; + ISET := nil; + IM := nil; + IP := nil; + DFS := nil; + MARG := nil; + PART := nil; + DGFR := nil; + GSQ := nil; + NSize := nil; + M := nil; + LogM := nil; + Indexes := nil; + Expected := nil; + Margins := nil; + Data := nil; + WorkVec := nil; + GridPos := nil; + Subscripts := nil; + DimSize := nil; + Labels := nil; +end; + +procedure TLogLinScreenFrm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := SelectList.ItemIndex; + if index < 0 then exit; + VarList.Items.Add(SelectList.Items.Strings[index]); + SelectList.Items.Delete(index); + index := SelectList.Items.Count; + if index <= 0 then OutBtn.Enabled := false; + InBtn.Enabled := true; + NoDims := NoDims - 1; + if NoDims > 0 then ScrollBar1.Max := NoDims else ScrollBar1.Max := 1; +end; + +procedure TLogLinScreenFrm.Screen(var NVAR: integer; var MP: integer; + var MM: integer; var NTAB: integer; var TABLE: DblDyneVec; + var DIM: IntDyneVec; var GSQ: DblDyneVec; var DGFR: IntDyneVec; + var PART: DblDyneMat; var MARG: DblDyneMat; var DFS: IntDyneMat; + var IP: IntDyneMat; var IM: IntDyneMat; var ISET: IntDyneVec; + var JSET: IntDyneVec; var CONFIG: IntDyneMat; var FIT: DblDyneVec; + var SIZE: IntDyneVec; var COORD: IntDyneVec; var X: DblDyneVec; + var Y: DblDyneVec; var IFAULT: integer); +Label 160, 170; +VAR ISZ, MAX, LIM, I, J, NV1, M, M1, ITP, NP, NP1, L3, DF : integer; + ZERO, G21, G22, G23, AVG : double; + +begin +// SUBROUTINE SCREEN(NVAR, MP, MM, NTAB, TABLE, DIM, GSQ, DGFR, +// * PART, MARG, DFS, IP, IM, ISET, JSET, CONFIG, FIT, SIZE, +// * COORD, X, Y, IFAULT) +// +// ALGORITHM AS 160 APPL. STATIST. (1981) VOL.30, NO.1 +// +// Screen all efects for partial and marginal association. +// +// INTEGER NVAR, MP, MM, NTAB, IP(NVAR,MP), IM(NVAR,MM), DGFR(NVAR), +// * DFS(NVAR,MP), ISET(NVAR), JSET(NVAR), CONFIG(NVAR,MP), +// * DIM(NVAR), DF, SIZE(NVAR), COORD(NVAR) +// REAL GSQ(NVAR), PART(NVAR,MP), MARG(NVAR,MP), TABLE(NTAB), +// * FIT(NTAB), X(NTAB), Y(NTAB), ZERO +// DATA ZERO /0.0/ +// +// Check for input errors +// + ZERO := 0.0; + IFAULT := 1; + IF (NVAR <= 1) then exit; + ISZ := 1; + for I := 1 to NVAR do + begin + if (DIM[I] <= 1) then IFAULT := 2; + ISZ := ISZ * DIM[i]; + end; + IF (ISZ <> NTAB) then IFAULT := 2; + MAX := 1; + LIM := NVAR div 2; + for I := 1 to LIM do MAX := MAX * (NVAR - I + 1) div I; + IF (MP < MAX) then IFAULT := 3; + MAX := 1; + LIM := (NVAR - 1) div 2; + for I := 1 to LIM do MAX := MAX * (NVAR - I) div I; + MAX := MAX * NVAR; + IF (MM < MAX) then IFAULT := 4; + IF (IFAULT > 1) then exit; +// +// Fit the no effect model +// + DGFR[NVAR] := NTAB - 1; + AVG := ZERO; + IFAULT := 5; + for I := 1 to NTAB do + begin + IF (TABLE[I] < ZERO) then exit; //RETURN + AVG := AVG + TABLE[I]; + end; + IFAULT := 0; + AVG := AVG / NTAB; + RESET(FIT, NTAB, AVG); + LIKE(GSQ[1], FIT, TABLE, NTAB); +// +// Begin fitting effects +// + NV1 := NVAR - 1; + for M := 1 to NV1 do + begin + // DO 200 M = 1, NV1 + // + // Set up the arrays IP and IM + // + M1 := M; + CONF(NVAR, M1, MP, MM, ISET, JSET, IP, IM, NP); + // + // Fit the saturated model + // + RESET(FIT, NTAB, AVG); + EVAL(IP, NP, M, 1, NVAR, MP, CONFIG, DIM, DGFR[M]); + LOGFIT(NVAR, NTAB, NP, DIM, CONFIG, TABLE, FIT, SIZE, COORD, X, Y); + LIKE(GSQ[M+1], FIT, TABLE, NTAB); + // + // Move the first column of IP to the last + // + for I := 1 to M do + begin + // DO 150 I = 1, M + ITP := IP[I,1]; + NP1 := NP - 1; + for J := 1 to NP1 do IP[I,J] := IP[I,J+1]; + IP[I,NP] := ITP; + end; // 150 CONTINUE + L3 := -M + 1; + for J := 1 to NP do + begin + // DO 190 J = 1, NP + // + // Fit the effects in IP ignoring the last column + // + RESET(FIT, NTAB, AVG); + EVAL(IP, NP-1, M, 1, NVAR, MP, CONFIG, DIM, DF); + LOGFIT(NVAR, NTAB, NP-1, DIM, CONFIG, TABLE, FIT, SIZE, COORD, X, Y); + LIKE(G21, FIT, TABLE, NTAB); + DFS[M,J] := DGFR[M] - DF; + PART[M,J] := G21 - GSQ[M+1]; + // + // For M = 1, partials and marginals are equal + // + IF (M > 1) then GOTO 160; + MARG[1,J] := PART[1,J]; + GOTO 170; + // + // Fit the last column alone + // + 160: RESET(FIT, NTAB, AVG); + EVAL(IP, 1, M, NP, NVAR, MP, CONFIG, DIM, DF); + LOGFIT(NVAR, NTAB, 1, DIM, CONFIG, TABLE, FIT, SIZE, + COORD, X, Y); + LIKE(G22, FIT, TABLE, NTAB); + // + // Locate the appropriate columns of IM and fit them + // + L3 := L3 + M; + RESET(FIT, NTAB, AVG); + EVAL(IM, M, M-1, L3, NVAR, MM, CONFIG, DIM, DF); + LOGFIT(NVAR, NTAB, M, DIM, CONFIG, TABLE, FIT, SIZE, + COORD, X, Y); + LIKE(G23, FIT, TABLE, NTAB); + MARG[M,J] := G23 - G22; + // + // Move the next effect to be ignored to the last in IP + // + 170: for I := 1 to M do // DO 180 I = 1, M + begin + ITP := IP[I,NP]; + IP[I,NP] := IP[I,J]; + IP[I,J] := ITP; + end; + // 180 CONTINUE + end; // 190 CONTINUE + // + DGFR[NVAR] := DGFR[NVAR] - DGFR[M]; + GSQ[M] := GSQ[M] - GSQ[M+1]; + end; // 200 CONTINUE +end; + +procedure TLogLinScreenFrm.CONF(var N: integer; var M: integer; + var MP: integer; var MM: integer; var ISET: IntDyneVec; var JSET: IntDyneVec; + var IP: IntDyneMat; var IM: IntDyneMat; var NP: integer); +Label 100, 120; +VAR + ILAST, JLAST : boolean; + I, L, NM, JS : integer; +// SUBROUTINE CONF(N, M, MP, MM, ISET, JSET, IP, IM, NP) +//C +//C ALGORITHM AS 160.1 APPL. STATIST. (1981) VOL.30, NO.1 +//C +//C Set up the arrays IP and IM for a given N and M. Essentially +//C IP contains all possible combinations of (N choose M). For each +//C combination found IM contains all combinations of degree M-1. +//C +// INTEGER ISET(N), JSET(N), IP(N,MP), IM(N,MM) +// LOGICAL ILAST, JLAST +//C + +begin + ILAST := TRUE; + NP := 0; + NM := 0; + // + // Get IP + // + 100: + COMBO(ISET, N, M, ILAST); + IF (ILAST) then exit; + NP := NP + 1; + for I := 1 to M do IP[I,NP] := ISET[I]; + IF (M = 1) then GOTO 100; +// +// Get IM +// + JLAST := TRUE; + L := M - 1; + 120: + COMBO(JSET, M, L, JLAST); + IF (JLAST) then GOTO 100; + NM := NM + 1; + for I := 1 to L do // DO 130 I = 1, L + begin + JS := JSET[I]; + IM[I,NM] := ISET[JS]; + end; // 130 CONTINUE + GOTO 120; +end; + +procedure TLogLinScreenFrm.COMBO(var ISET: IntDyneVec; N, M: Integer; + var LAST: boolean); +label 100, 110, 130, 150; +VAR + I, K, L : integer; + +// SUBROUTINE COMBO(ISET, N, M, LAST) +// +// ALGORITHM AS 160.2 APPL. STATIST. (1981) VOL.30, NO.1 +// +// Subroutine to generate all possible combinations of M of the +// integers from 1 to N in a stepwise fashion. Prior to the first +// call, LAST should be set to .FALSE. Thereafter, as long as LAST +// is returned .FALSE., a new valid combination has been generated. +// When LAST goes .TRUE., there are no more combinations. +// +// LOGICAL LAST +// INTEGER N, M, ISET(M) +// + +begin + IF (LAST) then GOTO 110; +// +// Get next element to increment +// + K := M; +100: L := ISET[K] + 1; + IF (L + M - K <= N) then GOTO 150; + K := K - 1; +// +// See if we are done +// + IF (K <= 0) then GOTO 130; + GOTO 100; +// +// Initialize first combination +// +110: for I := 1 to M do ISET[I] := I; +130: LAST := NOT LAST; + exit; +// +// Fill in remainder of combination. +// +150: for I := K to M do //DO 160 I = K, M + begin + ISET[I] := L; + L := L + 1; + end; //160 CONTINUE +end; + +procedure TLogLinScreenFrm.EVAL(var IAR: IntDyneMat; NC, NV, IBEG, NVAR, + MAX: integer; var CONFIG: IntDyneMat; var DIM: IntDyneVec; var DF: integer); +VAR I, J, K, KK, L : integer; +// SUBROUTINE EVAL(IAR, NC, NV, IBEG, NVAR, MAX, CONFIG, DIM, DF) +// +// ALGORITHM AS 160.3 APPL. STATIST. (1981) VOL.30, NO.1 +// +// IAR = array containing the effects to be fitted +// NC = number of columns of IAR to be used +// NV = number of variables in each effect +// IBEG = gebinning column +// DF = degrees of freedom +// +// CONFIG is in a format compatible with algorithm AS 51 +// +// INTEGER IAR(NVAR,MAX), CONFIG(NVAR,NC), DIM(NVAR), DF +// +begin + DF := 0; + for J := 1 to NC do //DO 110 J = 1, NC + begin + KK := 1; + for I := 1 to NV do //DO 100 I = 1, NV + begin + L := IBEG + J - 1; + K := IAR[I,L]; + KK := KK * (DIM[K] - 1); + CONFIG[I,J] := K; + end; // 100 CONTINUE + CONFIG[NV+1,J] := 0; + DF := DF + KK; + end; // 110 CONTINUE +end; + +procedure TLogLinScreenFrm.RESET(var FIT: DblDyneVec; NTAB: Integer; AVG: Double + ); +VAR I : integer; + +begin +// +// SUBROUTINE RESET(FIT, NTAB, AVG) +// +// ALGORITHM AS 160.4 APPL. STATIST. (1981) VOL.30, NO.1 +// +// Initialize the fitted values to the average entry +// +// REAL FIT(NTAB) +// + for I := 1 to NTAB do //DO 100 I = 1, NTAB + begin + FIT[I] := AVG; + end; // 100 CONTINUE +end; + +procedure TLogLinScreenFrm.LIKE(var GSQ: Double; var FIT: DblDyneVec; + var TABLE: DblDyneVec; NTAB: integer); +VAR I : integer; + ZERO, TWO : Double; + +begin + ZERO := 0.0; + TWO := 2.0; +// SUBROUTINE LIKE(GSQ, FIT, TABLE, NTAB) +// +// ALGORITHM AS 160.5 APPL. STATIST. (1981) VOL.30, NO.1 +// +// Compute the likelihood-ration chi-square +// +// REAL FIT(NTAB), TABLE(NTAB), ZERO, TWO +// DATA ZERO /0.0/, TWO /2.0/ +// + GSQ := ZERO; + for I := 1 to NTAB do //DO 100 I = 1, NTAB + begin + IF (FIT[I] = ZERO) OR (TABLE[I] = ZERO) then continue; // GO TO 100 + GSQ := GSQ + TABLE[I] * Ln(TABLE[I] / FIT[I]); + end; // 100 CONTINUE + GSQ := TWO * GSQ; +end; + +procedure TLogLinScreenFrm.LOGFIT(NVAR, NTAB, NCON: integer; + var DIM: IntDyneVec; var CONFIG: IntDyneMat; var TABLE: DblDyneVec; + var FIT: DblDyneVec; var SIZE: IntDyneVec; var COORD: IntDyneVec; + var X: DblDyneVec; var Y: DblDyneVec); +LABEL 110, 130, 150, 170, 180, 200; +VAR + II, K, KK, L, N, J, I : integer; + OPTION : boolean; + MAXDEV, ZERO, XMAX, E : double; + MAXIT, NV1, ISZ : integer; + +begin +// SUBROUTINE LOGFIT(NVAR, NTAB, NCON, DIM, CONFIG, TABLE, FIT, SIZE, +// * COORD, X, Y) +// +// ALGORITHM AS 160.6 APPL. STATIST. (1981) VOL.30, NO.1 +// +// Iterative proportional fitting of the marginals of a contingency +// table. Relevant code from AS 51 is used. +// +// REAL TABLE(NTAB), FIT(NTAB), MAXDEV, X(NTAB), Y(NTAB), ZERO +// INTEGER CONFIG(NVAR,NCON), DIM(NVAR), SIZE(NVAR), COORD(NVAR) +// LOGICAL OPTION +// DATA MAXDEV /0.25/, MAXIT /25/, ZERO /0.0/ + + MAXDEV := 0.25; + ZERO := 0.0; + MAXIT := 25; + for KK := 1 to MAXIT do //DO 230 KK = 1, MAXIT + begin + // + // XMAX is the maximum deviation between fitted and true marginal + // + XMAX := ZERO; + for II := 1 to NCON do //DO 220 II = 1, NCON + begin + OPTION := TRUE; + // + // Initialize arrays + // + SIZE[1] := 1; + NV1 := NVAR - 1; + for K := 1 to NV1 do //DO 100 K = 1, NV1 + begin + L := CONFIG[K,II]; + IF (L = 0) then GOTO 110; + SIZE[K+1] := SIZE[K] * DIM[L]; + end; // 100 CONTINUE + K := NVAR; + 110: N := K - 1; + ISZ := SIZE[K]; + for J := 1 to ISZ do //DO 120 J = 1, ISZ + begin + X[J] := ZERO; + Y[J] := ZERO; + end; // 120 CONTINUE + // + // Initialize co-ordinates + // + 130: for K := 1 to NVAR do COORD[K] := 0; + // + // Find locations in tables + // + I := 1; + 150: J := 1; + for K := 1 to N do //DO 160 K = 1, N + begin + L := CONFIG[K,II]; + J := J + COORD[L] * SIZE[K]; + end; //160 CONTINUE + IF (NOT OPTION) then GOTO 170; + // + // Compute marginals + // + X[J] := X[J] + TABLE[I]; + Y[J] := Y[J] + FIT[I]; + GOTO 180; + // + // Make adjustments + // + 170: IF (Y[J] <= ZERO) then FIT[I] := ZERO; + IF (Y[J] > ZERO) then FIT[I] := FIT[I] * X[J] / Y[J]; + // + // Update co-ordinates + // + 180: I := I + 1; + for K := 1 to NVAR do //DO 190 K = 1, NVAR + begin + COORD[K] := COORD[K] + 1; + IF (COORD[K] < DIM[K]) then GOTO 150; + COORD[K] := 0; + end; //190 CONTINUE + IF (NOT OPTION) then GOTO 200; + OPTION := FALSE; + GOTO 130; + // + // Find the largest deviation + // + 200: for I := 1 to ISZ do //DO 210 I = 1, ISZ + begin + E := ABS(X[I] - Y[I]); + IF (E > XMAX) then XMAX := E; + end; // 210 CONTINUE + end; // 220 CONTINUE + // + // Test convergence + // + IF (XMAX < MAXDEV) then exit; + end; // 230 CONTINUE +end; + +procedure TLogLinScreenFrm.MaxCombos(NoDims: integer; var MM: integer; + var MP: integer); +var + combos : integer; + i,j : integer; + +begin + MM := 0; + MP := 0; + for i := 1 to NoDims do + begin + combos := 1; + // get numerator factorial products down to i + for j := NoDims downto i + 1 do + combos := combos * j; + // divide by factorial of NoDims - i; + for j := (NoDims - i) downto 2 do + combos := combos div j; + if combos > MP then MP := combos; + if i * combos > MM then MM := i * combos; + end; +end; + +function TLogLinScreenFrm.ArrayPosition(Sender: TObject; NoDims : integer; + VAR Data : DblDyneVec; + VAR Subscripts : IntDyneVec; + VAR DimSize : IntDyneVec) : integer; + +var + Pos : integer; + i, j : integer; + PriorSizes : IntDyneVec; + +begin + // allocate space for PriorSizes + SetLength(PriorSizes,NoDims); + // calculate PriorSizes values + for i := 0 to NoDims - 2 do PriorSizes[i] := 1; // initialize + for i := NoDims - 2 downto 0 do + for j := 0 to i do PriorSizes[i] := PriorSizes[i] * DimSize[j]; + Pos := Subscripts[0] - 1; + for i := 0 to NoDims - 2 do + Pos := Pos + (PriorSizes[i] * (Subscripts[i+1]-1)); + Result := Pos; + PriorSizes := nil; +end; + +procedure TLogLinScreenFrm.Marginals(Sender: TObject; NoDims: integer; + ArraySize: integer; var Indexes: IntDyneMat; var Data: DblDyneVec; + var Margins: IntDyneMat); +var i, j, category : integer; + +begin + for i := 1 to ArraySize do + begin + for j := 1 to NoDims do + begin + category := Indexes[i-1,j-1]; + Margins[j-1,category-1] := Margins[j-1,category-1] + Round(Data[i-1]); + end; + end; +end; + +initialization + {$I loglinscreenunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/cross-classification/twowayloglinunit.lfm b/applications/lazstats/source/forms/analysis/cross-classification/twowayloglinunit.lfm new file mode 100644 index 000000000..d1a847f6e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/cross-classification/twowayloglinunit.lfm @@ -0,0 +1,435 @@ +object TwoWayLogLinFrm: TTwoWayLogLinFrm + Left = 494 + Height = 352 + Top = 237 + Width = 425 + AutoSize = True + Caption = 'Log Linear Analysis of a 2x2 Table' + ClientHeight = 352 + ClientWidth = 425 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object FileFromGrp: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 51 + Top = 8 + Width = 354 + AutoFill = False + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Enter Data From:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 16 + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 31 + ClientWidth = 350 + Columns = 2 + Items.Strings = ( + 'File Data in the Main Grid' + 'Data Entered on this Form' + ) + OnClick = FileFromGrpClick + TabOrder = 0 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 216 + Height = 25 + Top = 319 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 278 + Height = 25 + Top = 319 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 362 + Height = 25 + Top = 319 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 5 + end + object HelpBtn: TButton + Tag = 154 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 157 + Height = 25 + Top = 319 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 2 + end + object Notebook1: TNotebook + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = FileFromGrp + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 236 + Top = 67 + Width = 409 + PageIndex = 0 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 1 + object Page1: TPage + object Label1: TLabel + AnchorSideLeft.Control = RowVarEdit + AnchorSideBottom.Control = RowVarEdit + Left = 226 + Height = 15 + Top = 16 + Width = 67 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Row Variable' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ColVarEdit + AnchorSideBottom.Control = ColVarEdit + Left = 226 + Height = 15 + Top = 90 + Width = 87 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Column Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = FreqVarEdit + AnchorSideBottom.Control = FreqVarEdit + Left = 226 + Height = 15 + Top = 176 + Width = 99 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Frequency Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Page1 + AnchorSideTop.Control = Page1 + AnchorSideRight.Control = RowInBtn + AnchorSideBottom.Control = Page1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 236 + Top = 0 + Width = 182 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object RowInBtn: TBitBtn + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 190 + Height = 28 + Top = 8 + Width = 28 + BorderSpacing.Top = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = RowInBtnClick + Spacing = 0 + TabOrder = 1 + end + object RowOutBtn: TBitBtn + AnchorSideLeft.Control = RowInBtn + AnchorSideTop.Control = RowInBtn + AnchorSideTop.Side = asrBottom + Left = 190 + Height = 28 + Top = 40 + Width = 28 + BorderSpacing.Top = 4 + Enabled = False + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = RowOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object ColInBtn: TBitBtn + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Label2 + AnchorSideBottom.Control = ColVarEdit + AnchorSideBottom.Side = asrBottom + Left = 190 + Height = 28 + Top = 90 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ColInBtnClick + Spacing = 0 + TabOrder = 4 + end + object ColOutBtn: TBitBtn + AnchorSideLeft.Control = ColInBtn + AnchorSideTop.Control = ColInBtn + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 190 + Height = 28 + Top = 122 + Width = 28 + BorderSpacing.Top = 4 + Enabled = False + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ColOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object FreqInBtn: TBitBtn + AnchorSideLeft.Control = Page1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = FreqOutBtn + Left = 190 + Height = 28 + Top = 168 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = FreqInBtnClick + Spacing = 0 + TabOrder = 7 + end + object FreqOutBtn: TBitBtn + AnchorSideLeft.Control = FreqInBtn + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 190 + Height = 28 + Top = 200 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 8 + Enabled = False + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = FreqOutBtnClick + Spacing = 0 + TabOrder = 8 + end + object RowVarEdit: TEdit + AnchorSideLeft.Control = RowInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Page1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = RowOutBtn + AnchorSideBottom.Side = asrBottom + Left = 226 + Height = 23 + Top = 33 + Width = 183 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'RowVarEdit' + end + object ColVarEdit: TEdit + AnchorSideLeft.Control = RowInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Page1 + AnchorSideRight.Side = asrBottom + Left = 226 + Height = 23 + Top = 107 + Width = 183 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + ReadOnly = True + TabOrder = 6 + Text = 'ColVarEdit' + end + object FreqVarEdit: TEdit + AnchorSideLeft.Control = FreqInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Page1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = FreqOutBtn + AnchorSideBottom.Side = asrBottom + Left = 226 + Height = 23 + Top = 193 + Width = 183 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 9 + Text = 'FreqVarEdit' + end + end + object Page2: TPage + object NoRowsLabel: TLabel + AnchorSideLeft.Control = Page2 + AnchorSideTop.Control = NoRowsEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 4 + Width = 67 + Caption = 'No. of Rows:' + ParentColor = False + end + object NoColsLabel: TLabel + AnchorSideLeft.Control = NoRowsEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NoColsEdit + AnchorSideTop.Side = asrCenter + Left = 138 + Height = 15 + Top = 4 + Width = 87 + BorderSpacing.Left = 24 + BorderSpacing.Right = 8 + Caption = 'No. of Columns:' + ParentColor = False + end + object NoRowsEdit: TEdit + AnchorSideLeft.Control = NoRowsLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Page2 + Left = 75 + Height = 23 + Top = 0 + Width = 39 + Alignment = taRightJustify + BorderSpacing.Left = 8 + OnKeyPress = NoRowsEditKeyPress + TabOrder = 0 + Text = 'NoRowsEdit' + end + object NoColsEdit: TEdit + AnchorSideLeft.Control = NoColsLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Page2 + AnchorSideRight.Control = Page2 + AnchorSideRight.Side = asrBottom + Left = 233 + Height = 23 + Top = 0 + Width = 46 + Alignment = taRightJustify + BorderSpacing.Left = 8 + OnKeyPress = NoColsEditKeyPress + TabOrder = 1 + Text = 'Edit1' + end + object Grid: TStringGrid + AnchorSideLeft.Control = Page2 + AnchorSideTop.Control = NoRowsEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Page2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Page2 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 235 + Top = 31 + Width = 373 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 8 + ColCount = 2 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goTabs, goThumbTracking, goSmoothScroll] + RowCount = 2 + TabOrder = 2 + end + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 303 + Width = 425 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Bevel2: TBevel + Left = 3 + Height = 14 + Top = 336 + Width = 18 + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/cross-classification/twowayloglinunit.pas b/applications/lazstats/source/forms/analysis/cross-classification/twowayloglinunit.pas new file mode 100644 index 000000000..c7e92da7e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/cross-classification/twowayloglinunit.pas @@ -0,0 +1,886 @@ +unit TwoWayLogLinUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, Buttons, Grids, + OutputUnit, MainUnit, Globals, DataProcs, ContextHelpUnit; + +type + + { TTwoWayLogLinFrm } + + TTwoWayLogLinFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + HelpBtn: TButton; + Notebook1: TNotebook; + Page1: TPage; + Page2: TPage; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + RowInBtn: TBitBtn; + RowOutBtn: TBitBtn; + ColInBtn: TBitBtn; + ColOutBtn: TBitBtn; + FreqInBtn: TBitBtn; + FreqOutBtn: TBitBtn; + NoRowsEdit: TEdit; + NoColsEdit: TEdit; + NoRowsLabel: TLabel; + NoColsLabel: TLabel; + RowVarEdit: TEdit; + ColVarEdit: TEdit; + FreqVarEdit: TEdit; + FileFromGrp: TRadioGroup; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Grid: TStringGrid; + VarList: TListBox; + procedure ColInBtnClick(Sender: TObject); + procedure ColOutBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FileFromGrpClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure FreqInBtnClick(Sender: TObject); + procedure FreqOutBtnClick(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure NoColsEditKeyPress(Sender: TObject; var Key: char); + procedure NoRowsEditKeyPress(Sender: TObject; var Key: char); + procedure ResetBtnClick(Sender: TObject); + procedure RowInBtnClick(Sender: TObject); + procedure RowOutBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + + procedure PrintTable(Nrows, Ncols: integer; const Data: DblDyneMat; + const RowMarg, ColMarg: DblDyneVec; Total: double; AReport: TStrings); + procedure Iterate(Nrows, Ncols: integer; + const Data: DblDyneMat; const RowMarg, ColMarg: DblDyneVec; + var Total: double; + const Expected: DblDyneMat; const NewRowMarg, NewColMarg: DblDyneVec; + var NewTotal: double); + procedure PrintLamdas(Nrows, Ncols : integer; const CellLambdas: DblDyneCube; + mu: double; AReport: TStrings); + + public + { public declarations } + end; + +var + TwoWayLogLinFrm: TTwoWayLogLinFrm; + +implementation + +uses + Math; + +{ TTwoWayLogLinFrm } + +procedure TTwoWayLogLinFrm.ResetBtnClick(Sender: TObject); +VAR i, j : integer; +begin + for i := 0 to Grid.RowCount - 1 do + for j := 0 to Grid.ColCount - 1 do + Grid.Cells[j,i] := ''; + Grid.ColCount := 3; + Grid.RowCount := 2; + Grid.Cells[0,0] := 'ROW'; + Grid.Cells[1,0] := 'COL'; + Grid.Cells[2,0] := 'FREQ'; + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + RowVarEdit.Text := ''; + ColVarEdit.Text := ''; + FreqVarEdit.Text := ''; + NoRowsEdit.Text := ''; + NoColsEdit.Text := ''; + FileFromGrp.ItemIndex := -1; + Notebook1.Hide; + { + VarList.Visible := false; + RowInBtn.Enabled := false; + RowOutBtn.Enabled := false; + ColInBtn.Enabled := false; + ColOutBtn.Enabled := false; + FreqInBtn.Enabled := false; + FreqOutBtn.Enabled := false; + Label1.Visible := false; + Label2.Visible := false; + Label3.Visible := false; + RowVarEdit.Visible := false; + ColVarEdit.Visible := false; + FreqVarEdit.Visible := false; +// Memo1.Visible := false; + NoRowsLabel.Visible := false; + NoColsLabel.Visible := false; + NoRowsEdit.Visible := false; + NoColsEdit.Visible := false; + Grid.Visible := false; + } +end; + +procedure TTwoWayLogLinFrm.RowInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (RowVarEdit.Text = '') then + begin + RowVarEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TTwoWayLogLinFrm.RowOutBtnClick(Sender: TObject); +begin + if RowVarEdit.Text <> '' then + begin + VarList.Items.Add(RowVarEdit.Text); + RowVarEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TTwoWayLogLinFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TTwoWayLogLinFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TTwoWayLogLinFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TTwoWayLogLinFrm.FreqInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (FreqVarEdit.Text = '') then + begin + FreqVarEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TTwoWayLogLinFrm.FreqOutBtnClick(Sender: TObject); +begin + if FreqVarEdit.Text <> '' then + begin + VarList.Items.Add(FreqVarEdit.Text); + FreqVarEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TTwoWayLogLinFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TTwoWayLogLinFrm.NoColsEditKeyPress(Sender: TObject; var Key: char); +var + i, j, row : integer; + Ncols, Nrows : integer; + +begin + if ord(Key) = 13 then + begin + Nrows := StrToInt(NoRowsEdit.Text); + Ncols := StrToInt(NoColsEdit.Text); + Grid.RowCount := (Nrows * Ncols) + 1; + // setup row and column values in the grid + row := 1; + for j := 1 to Ncols do + begin + for i := 1 to Nrows do + begin + Grid.Cells[0,row] := IntToStr(i); + Grid.Cells[1,row] := IntToStr(j); + row := row + 1; + end; + end; + Grid.SetFocus; + end; +end; + +procedure TTwoWayLogLinFrm.NoRowsEditKeyPress(Sender: TObject; var Key: char); +begin + if ord(Key) = 13 then NoColsEdit.SetFocus; +end; + +procedure TTwoWayLogLinFrm.ComputeBtnClick(Sender: TObject); +var + Data : DblDyneMat; + NewData : DblDyneMat; + Prop : DblDyneMat; + LogData : DblDyneMat; + Expected : DblDyneMat; + i, j, k : integer; + RowMarg : DblDyneVec; + NewRowMarg : DblDyneVec; + RowLogs : DblDyneVec; + ColMarg : DblDyneVec; + NewColMarg : DblDyneVec; + ColLogs : DblDyneVec; + CellLambdas : DblDyneCube; + Total : double; + NewTotal : double; + TotalLogs : double; + mu : double; + row, col : integer; + ModelTotal : double; + astr : string; + Ysqr : double; + DF : integer; + chisqr: double; + odds : double; + Nrows, Ncols : integer; + RowCol, ColCol, Fcol : integer; + GridPos : IntDyneVec; + value : integer; + Fx : double; + lReport: TStrings; + +begin + Total := 0.0; + TotalLogs := 0.0; + Nrows := 0; + Ncols := 0; + + if FileFromGrp.ItemIndex = 0 then // mainfrm input + begin + SetLength(GridPos,3); + for i := 1 to NoVariables do + begin + if RowVarEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then GridPos[0] := i; + if ColVarEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then GridPos[1] := i; + if FreqVarEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then GridPos[2] := i; + end; + // get no. of rows and columns + for i := 1 to OS3MainFrm.DataGrid.RowCount - 1 do + begin + value := StrToInt(OS3MainFrm.DataGrid.Cells[GridPos[0],i]); + if value > Nrows then Nrows := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[GridPos[1],i]); + if value > Ncols then Ncols := value; + end; + + // Get data + SetLength(Data,Nrows+1,Ncols+1); + SetLength(CellLambdas,Nrows+1,Ncols+1,4); + SetLength(RowMarg,Nrows+1); + SetLength(RowLogs,Nrows+1); + SetLength(ColMarg,Ncols+1); + SetLength(ColLogs,Ncols+1); + SetLength(Prop,Nrows+1,Ncols+1); + SetLength(LogData,Nrows+1,Ncols+1); + SetLength(Expected,Nrows+1,Ncols+1); + SetLength(NewData,Nrows+1,Ncols+1); + SetLength(NewRowMarg,Nrows+1); + SetLength(NewColMarg,Ncols+1); + + for i := 1 to Nrows do + for j := 1 to Ncols do + Data[i,j] := 0.0; + rowcol := GridPos[0]; + colcol := GridPos[1]; + Fcol := GridPos[2]; + for i := 1 to OS3MainFrm.DataGrid.RowCount - 1 do + begin + if Not GoodRecord(i, 3, GridPos) then continue; + row := StrToInt(OS3MainFrm.DataGrid.Cells[rowcol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[colcol,i]); + Fx := StrToInt(OS3MainFrm.DataGrid.Cells[Fcol,i]); + Data[row,col] := Data[row,col] + Fx; + Total := Total + Fx; + end; + GridPos := nil; + end; + + if FileFromGrp.ItemIndex = 1 then // form data + begin + Nrows := StrToInt(NoRowsEdit.Text); + Ncols := StrToInt(NoColsEdit.Text); + SetLength(Data,Nrows+1,Ncols+1); + SetLength(CellLambdas,Nrows+1,Ncols+1,4); + SetLength(RowMarg,Nrows+1); + SetLength(RowLogs,Nrows+1); + SetLength(ColMarg,Ncols+1); + SetLength(ColLogs,Ncols+1); + SetLength(Prop,Nrows+1,Ncols+1); + SetLength(LogData,Nrows+1,Ncols+1); + SetLength(Expected,Nrows+1,Ncols+1); + SetLength(NewData,Nrows+1,Ncols+1); + SetLength(NewRowMarg,Nrows+1); + SetLength(NewColMarg,Ncols+1); + end; + + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to 3 do CellLambdas[i,j,k] := 0.0; + + for i := 1 to Nrows do + begin + RowMarg[i] := 0.0; + RowLogs[i] := 0.0; + end; + + for j := 1 to Ncols do + begin + ColMarg[j] := 0.0; + ColLogs[j] := 0.0; + end; + + if FileFromGrp.ItemIndex = 1 then // get data from grid + begin + for i := 1 to (Nrows * Ncols) do + begin + row := StrToInt(Grid.Cells[0,i]); + col := StrToInt(Grid.Cells[1,i]); + Data[row,col] := StrToFloat(Grid.Cells[2,i]); + Total := Total + Data[row,col]; + end; + end; + + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + RowMarg[i] := RowMarg[i] + Data[i,j]; + ColMarg[j] := ColMarg[j] + Data[i,j]; + Prop[i,j] := Prop[i,j] / Total; + LogData[i,j] := ln(Data[i,j]); + end; + end; + + // report cross-products odds and log odds ratios + lReport := TStringList.Create; + try + lReport.Add('ANALYSES FOR AN I BY J CLASSIFICATION TABLE'); + lReport.Add(''); + lReport.Add('Reference: G.J.G. Upton, The Analysis of Cross-tabulated Data, 1980'); + lReport.Add(''); + if (Nrows = 2) and (Ncols = 2) then + begin + odds := (Data[1,1] * Data[2,2]) / (Data[1,2] * Data[2,1]); + lReport.Add('Cross-Products Odds Ratio: %6.3f', [odds]); + lReport.Add('Log odds of the cross-products ratio: %6.3f', [ln(odds)]); + lReport.Add(''); + end; + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + RowLogs[i] := RowLogs[i] + LogData[i,j]; + ColLogs[j] := ColLogs[j] + LogData[i,j]; + TotalLogs := TotalLogs + LogData[i,j]; + end; + end; + + for i := 1 to Nrows do RowLogs[i] := RowLogs[i] / Ncols; + for j := 1 to Ncols do ColLogs[j] := ColLogs[j] / Nrows; + TotalLogs := TotalLogs / (Nrows * Ncols); + mu := TotalLogs; + + for i := 1 to Nrows do + for j := 1 to Ncols do + begin + CellLambdas[i,j,1] := RowLogs[i] - TotalLogs; + CellLambdas[i,j,2] := ColLogs[j] - TotalLogs; + CellLambdas[i,j,3] := LogData[i,j] - RowLogs[i] - ColLogs[j] + TotalLogs; + end; + + // Get expected values for saturated model + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + ModelTotal := mu; + for k := 1 to 3 do + ModelTotal := ModelTotal + CellLambdas[i,j,k]; + Expected[i,j] := exp(ModelTotal); + end; + end; + + // Get Y square for saturated model + Ysqr := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + Ysqr := Ysqr + Data[i,j] * (ln(Data[i,j]) - ln(Expected[i,j])); + Ysqr := 2.0 * Ysqr; + + // write out values for saturated model + lReport.Add('Saturated Model Results'); + lReport.Add(''); + lReport.Add('Observed Frequencies'); + PrintTable(Nrows, Ncols, Data, RowMarg, ColMarg, Total, lReport); + lReport.Add('Log frequencies, row average and column average of log frequencies'); + PrintTable(Nrows, Ncols, LogData, RowLogs, ColLogs, TotalLogs, lReport); + lReport.Add('Expected Frequencies'); + PrintTable(Nrows, Ncols, Expected, RowMarg, ColMarg, Total, lReport); + + lReport.Add('Cell Parameters'); + PrintLamdas(Nrows, Ncols, CellLambdas, mu, lReport); + + lReport.Add('Y squared statistic for model fit: ' + format('%.3f',[Ysqr]) + ' D.F. 0'); + + lReport.Add(''); + lReport.Add('======================================================================='); + lReport.Add(''); + + // Do the model of independence + lReport.Add('Independent Effects Model Results'); + lReport.Add(''); + + lReport.Add('Expected Frequencies'); + Iterate(Nrows,Ncols, Data, RowMarg, ColMarg, Total, Expected, NewRowMarg, NewColMarg, NewTotal); + PrintTable(Nrows, Ncols, Expected, NewRowMarg, NewColMarg, NewTotal, lReport); + for i := 1 to Nrows do + for j := 1 to Ncols do + LogData[i,j] := ln(Expected[i,j]); + for i := 1 to Nrows do RowLogs[i] := 0.0; + for j := 1 to Ncols do ColLogs[j] := 0.0; + TotalLogs := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + begin + RowLogs[i] := RowLogs[i] + LogData[i,j]; + ColLogs[j] := ColLogs[j] + LogData[i,j]; + TotalLogs := TotalLogs + LogData[i,j]; + end; + + for i := 1 to Nrows do RowLogs[i] := RowLogs[i] / Ncols; + for j := 1 to Ncols do ColLogs[j] := ColLogs[j] / Nrows; + TotalLogs := TotalLogs / (Nrows * Ncols); + mu := TotalLogs; + + for i := 1 to Nrows do + for j := 1 to Ncols do + begin + CellLambdas[i,j,1] := RowLogs[i] - TotalLogs; + CellLambdas[i,j,2] := ColLogs[j] - TotalLogs; + CellLambdas[i,j,3] := LogData[i,j] - RowLogs[i] - ColLogs[j] + TotalLogs; + end; + lReport.Add('Cell Parameters'); + PrintLamdas(Nrows, Ncols, CellLambdas, mu, lReport); + + Ysqr := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + Ysqr := Ysqr + Data[i,j] * (ln(Data[i,j]) - ln(Expected[i,j])); + Ysqr := 2.0 * Ysqr; + lReport.Add(''); + astr := 'Y squared statistic for model fit: ' + Format('%.3f',[Ysqr]); + DF := (NRows - 1) * (NCols - 1); + astr := astr + ', D.F. = ' + IntToStr(DF); + lReport.Add(astr); + + chisqr := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + chisqr := chisqr + (power((Data[i,j] - Expected[i,j]),2) / Expected[i,j]); + lReport.Add('Chi-squared = %.3f with %d D.F.', [chisqr, DF]); + + lReport.Add(''); + lReport.Add('======================================================================='); + lReport.Add(''); + + // Do no Column Effects model + lReport.Add('No Column Effects Model Results'); + lReport.Add(''); + for i := 1 to Nrows do + for j := 1 to Ncols do + Expected[i,j] := RowMarg[i] / Ncols; + for i := 1 to Nrows do NewRowMarg[i] := 0.0; + for j := 1 to Ncols do NewColMarg[j] := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + begin + NewRowMarg[i] := NewRowMarg[i] + Expected[i,j]; + NewColMarg[j] := NewColMarg[j] + Expected[i,j]; + end; + lReport.Add('Expected Frequencies'); + PrintTable(Nrows, Ncols, Expected, NewRowMarg, NewColMarg, NewTotal, lReport); + + for i := 1 to Nrows do + for j := 1 to Ncols do + LogData[i,j] := ln(Expected[i,j]); + for i := 1 to Nrows do RowLogs[i] := 0.0; + for j := 1 to Ncols do ColLogs[j] := 0.0; + TotalLogs := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + begin + RowLogs[i] := RowLogs[i] + LogData[i,j]; + ColLogs[j] := ColLogs[j] + LogData[i,j]; + TotalLogs := TotalLogs + LogData[i,j]; + end; + + for i := 1 to Nrows do RowLogs[i] := RowLogs[i] / Ncols; + for j := 1 to Ncols do ColLogs[j] := ColLogs[j] / Nrows; + TotalLogs := TotalLogs / (Nrows * Ncols); + mu := TotalLogs; + + for i := 1 to Nrows do + for j := 1 to Ncols do + begin + CellLambdas[i,j,1] := RowLogs[i] - TotalLogs; + CellLambdas[i,j,2] := ColLogs[j] - TotalLogs; + CellLambdas[i,j,3] := LogData[i,j] - RowLogs[i] - ColLogs[j] + TotalLogs; + end; + + lReport.Add('Cell Parameters'); + PrintLamdas(Nrows, Ncols, CellLambdas, mu, lReport); + + Ysqr := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + Ysqr := Ysqr + Data[i,j] * (ln(Data[i,j]) - ln(Expected[i,j])); + Ysqr := 2.0 * Ysqr; + lReport.Add(''); + + astr := 'Y squared statistic for model fit: ' + Format('%.3f',[Ysqr]); + DF := (Nrows - 1) * Ncols; + astr := astr + ', D.F. ' + IntToStr(DF); + lReport.Add(astr); + + lReport.Add(''); + lReport.Add('======================================================================='); + lReport.Add(''); + + // Do no Row Effects model + lReport.Add('No Row Effects Model Results'); + lReport.Add(''); + for i := 1 to Nrows do + for j := 1 to Ncols do + Expected[i,j] := ColMarg[j] / Nrows; + for i := 1 to Nrows do NewRowMarg[i] := 0.0; + for j := 1 to Ncols do NewColMarg[j] := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + begin + NewRowMarg[i] := NewRowMarg[i] + Expected[i,j]; + NewColMarg[j] := NewColMarg[j] + Expected[i,j]; + end; + + lReport.Add('Expected Frequencies'); + PrintTable(Nrows, Ncols, Expected, NewRowMarg, NewColMarg, NewTotal, lReport); + for i := 1 to Nrows do + for j := 1 to Ncols do + LogData[i,j] := ln(Expected[i,j]); + for i := 1 to Nrows do RowLogs[i] := 0.0; + for j := 1 to Ncols do ColLogs[j] := 0.0; + TotalLogs := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + begin + RowLogs[i] := RowLogs[i] + LogData[i,j]; + ColLogs[j] := ColLogs[j] + LogData[i,j]; + TotalLogs := TotalLogs + LogData[i,j]; + end; + + for i := 1 to Nrows do RowLogs[i] := RowLogs[i] / Ncols; + for j := 1 to Ncols do ColLogs[j] := ColLogs[j] / Nrows; + TotalLogs := TotalLogs / (Nrows * Ncols); + mu := TotalLogs; + + for i := 1 to Nrows do + for j := 1 to Ncols do + begin + CellLambdas[i,j,1] := RowLogs[i] - TotalLogs; + CellLambdas[i,j,2] := ColLogs[j] - TotalLogs; + CellLambdas[i,j,3] := LogData[i,j] - RowLogs[i] - ColLogs[j] + TotalLogs; + end; + + lReport.Add('Cell Parameters'); + PrintLamdas(Nrows, Ncols, CellLambdas, mu, lReport); + Ysqr := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + Ysqr := Ysqr + Data[i,j] * (ln(Data[i,j]) - ln(Expected[i,j])); + Ysqr := 2.0 * Ysqr; + lReport.Add(''); + astr := 'Y squared statistic for model fit: ' + Format('%.3f', [Ysqr]); + DF := (Ncols - 1) * Nrows; + astr := astr + ', D.F. ' + IntToStr(DF); + lReport.Add(astr); + + lReport.Add(''); + lReport.Add('======================================================================='); + lReport.Add(''); + + // Do equiprobability model + lReport.Add('Equiprobability Effects Model Results'); + lReport.Add(''); + for i := 1 to Nrows do + for j := 1 to Ncols do + Expected[i,j] := Total / (Nrows * Ncols); + for i := 1 to Nrows do NewRowMarg[i] := Total / (Nrows * Ncols); + for j := 1 to 2 do NewColMarg[j] := Total / (Nrows * Ncols); + + lReport.Add('Expected Frequencies'); + PrintTable(Nrows, Ncols, Expected, NewRowMarg, NewColMarg, NewTotal, lReport); + for i := 1 to Nrows do + for j := 1 to Ncols do + LogData[i,j] := ln(Expected[i,j]); + for i := 1 to Nrows do RowLogs[i] := 0.0; + for j := 1 to Ncols do ColLogs[j] := 0.0; + TotalLogs := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + begin + RowLogs[i] := RowLogs[i] + LogData[i,j]; + ColLogs[j] := ColLogs[j] + LogData[i,j]; + TotalLogs := TotalLogs + LogData[i,j]; + end; + + for i := 1 to Nrows do RowLogs[i] := RowLogs[i] / Ncols; + for j := 1 to Ncols do ColLogs[j] := ColLogs[j] / Nrows; + TotalLogs := TotalLogs / (Nrows * Ncols); + mu := TotalLogs; + + for i := 1 to Nrows do + for j := 1 to Ncols do + begin + CellLambdas[i,j,1] := RowLogs[i] - TotalLogs; + CellLambdas[i,j,2] := ColLogs[j] - TotalLogs; + CellLambdas[i,j,3] := LogData[i,j] - RowLogs[i] - ColLogs[j] + TotalLogs; + end; + + lReport.Add('Cell Parameters'); + PrintLamdas(Nrows, Ncols, CellLambdas, mu, lReport); + Ysqr := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + Ysqr := Ysqr + Data[i,j] * (ln(Data[i,j]) - ln(Expected[i,j])); + Ysqr := 2.0 * Ysqr; + lReport.Add(''); + astr := 'Y squared statistic for model fit: ' + format('%.3f',[Ysqr]); + DF := Nrows * Ncols - 1; + astr := astr + ', D.F. ' + IntToStr(DF); + lReport.Add(astr); + + DisplayReport(lReport); + + finally + lReport.Free; + + NewColMarg := nil; + NewRowMarg := nil; + NewData := nil; + Expected := nil; + LogData := nil; + Prop := nil; + ColLogs := nil; + ColMarg := nil; + RowLogs := nil; + RowMarg := nil; + CellLambdas := nil; + Data := nil; + end; +end; + +procedure TTwoWayLogLinFrm.FileFromGrpClick(Sender: TObject); +begin + Notebook1.PageIndex := FileFromGrp.ItemIndex; + Notebook1.Show; +end; + +procedure TTwoWayLogLinFrm.ColInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (ColVarEdit.Text = '') then + begin + ColVarEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TTwoWayLogLinFrm.ColOutBtnClick(Sender: TObject); +begin + if ColVarEdit.Text <> '' then + begin + VarList.Items.Add(ColVarEdit.Text); + ColVarEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TTwoWayLogLinFrm.PrintTable(Nrows, Ncols : integer; + const Data: DblDyneMat; const RowMarg, ColMarg: DblDyneVec; + Total: double; AReport: TStrings); +var + astr: string; + i, j: integer; +begin + astr := 'ROW/COL '; + for j := 1 to Ncols do astr := astr + Format(' %3d ', [j]); + astr := astr + ' TOTAL'; + AReport. Add(astr); + + for i := 1 to Nrows do + begin + astr := Format(' %3d ', [i]); + for j := 1 to Ncols do + astr := astr + Format(' %8.2f ', [Data[i,j]]); + astr := astr + Format(' %8.2f ', [RowMarg[i]]); + AReport.Add(astr); + end; + + astr := 'TOTAL '; + for j := 1 to Ncols do astr := astr + Format(' %8.2f ',[ColMarg[j]]); + astr := astr + Format(' %8.2f ', [Total]); + AReport.Add(astr); + AReport.Add(''); +end; + +procedure TTwoWayLogLinFrm.Iterate(Nrows, Ncols: integer; + const Data: DblDyneMat; const RowMarg, ColMarg: DblDyneVec; var Total: double; + const Expected: DblDyneMat; const NewRowMarg, NewColMarg: DblDyneVec; var NewTotal: double); +Label Step; +var + Aprevious: DblDyneMat; + i, j: integer; + delta: double; + difference: double; +begin + delta := 0.1; + difference := 0.0; + SetLength(Aprevious, Nrows+1, Ncols+1); + + // initialize expected values + for i := 1 to Nrows do + for j := 1 to Ncols do + begin + expected[i,j] := 1.0; + Aprevious[i,j] := 1.0; + end; + +Step: + // step 1: initialize new row margins and calculate expected value + for i := 1 to Nrows do + for j := 1 to Ncols do + newrowmarg[i] := newrowmarg[i] + expected[i,j]; + + for i := 1 to Nrows do + for j := 1 to Ncols do + expected[i,j] := (RowMarg[i] / newrowmarg[i]) * expected[i,j]; + + // step 2: initialize new col margins and calculate expected values + for i := 1 to Nrows do + for j := 1 to Ncols do + newcolmarg[j] := newcolmarg[j] + expected[i,j]; + + for i := 1 to Nrows do + for j := 1 to Ncols do + expected[i,j] := (ColMarg[j] / newcolmarg[j]) * expected[i,j]; + + // step 3: check for change and quit if smaller than delta + for i := 1 to Nrows do + for j := 1 to Ncols do + if abs(APrevious[i,j]-expected[i,j]) > difference then + difference := abs(APrevious[i,j]-expected[i,j]); + + if difference < delta then + begin + newtotal := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + newtotal := newtotal + expected[i,j]; + exit; + end else + begin + for i := 1 to Nrows do + for j := 1 to Ncols do + APrevious[i,j] := expected[i,j]; + for i := 1 to Nrows do newrowmarg[i] := 0.0; + for j := 1 to Ncols do newcolmarg[j] := 0.0; + difference := 0.0; + goto step; + end; + Aprevious := nil; +end; + +procedure TTwoWayLogLinFrm.PrintLamdas(Nrows,Ncols: integer; + const CellLambdas: DblDyneCube; mu: double; AReport: TStrings); +var + i, j, k: integer; + astr: string; +begin + AReport.Add('ROW COL MU LAMBDA ROW LAMBDA COL LAMBDA ROW x COL'); + + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + astr := Format('%3d %3d ', [i, j]); + astr := astr + Format('%6.3f ', [mu]); + for k := 1 to 3 do + astr := astr + format(' %6.3f ', [CellLambdas[i,j,k]]); + AReport.Add(astr); + end; + end; + AReport.Add(''); +end; + +procedure TTwoWayLogLinFrm.UpdateBtnStates; +begin + RowInBtn.Enabled := (VarList.ItemIndex > -1) and (RowVarEdit.Text = ''); + ColInBtn.Enabled := (VarList.ItemIndex > -1) and (ColVarEdit.Text = ''); + FreqInBtn.Enabled := (VarList.ItemIndex > -1) and (FreqVarEdit.Text = ''); + RowOutBtn.Enabled := (RowVarEdit.Text <> ''); + ColOutBtn.Enabled := (ColVarEdit.Text <> ''); + FreqOutBtn.Enabled := (FreqVarEdit.Text <> ''); +end; + +procedure TTwoWayLogLinFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I twowayloglinunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/boxplotunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/boxplotunit.lfm new file mode 100644 index 000000000..f3427f97a --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/boxplotunit.lfm @@ -0,0 +1,222 @@ +object BoxPlotFrm: TBoxPlotFrm + Left = 440 + Height = 365 + Top = 119 + Width = 361 + AutoSize = True + Caption = 'Box Plot' + ClientHeight = 365 + ClientWidth = 361 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 294 + Height = 25 + Top = 332 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 7 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 210 + Height = 25 + Top = 332 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 148 + Height = 25 + Top = 332 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object HelpBtn: TButton + Tag = 108 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 89 + Height = 25 + Top = 332 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 4 + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 316 + Width = 361 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = HorCenterBevel + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 291 + Top = 25 + Width = 168 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + Constraints.MinHeight = 200 + ItemHeight = 0 + OnClick = VarListClick + TabOrder = 0 + end + object HorCenterBevel: TBevel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 176 + Height = 78 + Top = 55 + Width = 8 + Shape = bsSpacer + end + object Label2: TLabel + AnchorSideLeft.Control = HorCenterBevel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + Left = 184 + Height = 15 + Top = 8 + Width = 77 + BorderSpacing.Top = 8 + Caption = 'Group Variable' + ParentColor = False + end + object GroupEdit: TEdit + AnchorSideLeft.Control = HorCenterBevel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 184 + Height = 23 + Top = 25 + Width = 169 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 1 + Text = 'GroupEdit' + end + object Label3: TLabel + AnchorSideLeft.Control = MeasEdit + AnchorSideBottom.Control = MeasEdit + Left = 184 + Height = 15 + Top = 142 + Width = 112 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Meaurement Variable' + ParentColor = False + end + object MeasEdit: TEdit + AnchorSideLeft.Control = HorCenterBevel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 184 + Height = 23 + Top = 159 + Width = 169 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Right = 8 + TabOrder = 2 + Text = 'MeasEdit' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = HorCenterBevel + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 184 + Height = 51 + Top = 265 + Width = 143 + Anchors = [akLeft, akBottom] + AutoSize = True + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ClientHeight = 31 + ClientWidth = 139 + TabOrder = 3 + object ShowChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 115 + Caption = 'Show Frequencies' + TabOrder = 0 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/boxplotunit.pas b/applications/lazstats/source/forms/analysis/descriptive/boxplotunit.pas new file mode 100644 index 000000000..e68e95c03 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/boxplotunit.pas @@ -0,0 +1,721 @@ +// Use file "anova2.laz" for testing + +unit BoxPlotUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Printers, + MainUnit, Globals, DataProcs, OutputUnit, BlankFrmUnit, ContextHelpUnit; + + +type + + { TBoxPlotFrm } + + TBoxPlotFrm = class(TForm) + HorCenterBevel: TBevel; + Bevel2: TBevel; + HelpBtn: TButton; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + ShowChk: TCheckBox; + GroupBox1: TGroupBox; + MeasEdit: TEdit; + GroupEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + function Percentile(nscrgrps : integer; + pcnt : double; + VAR freq : DblDyneVec; + VAR cumfreq : DblDyneVec; + VAR scores : DblDyneVec) : double; + { + procedure pBoxPlot(nbars : integer; + max, min : double; + VAR lowqrtl : DblDyneVec; + VAR hiqrtl : DblDyneVec; + VAR tenpcnt : DblDyneVec; + VAR ninetypcnt : DblDyneVec; + VAR means : DblDyneVec; + VAR median : DblDyneVec); + } + procedure BoxPlot(nbars : integer; + max, min : double; + VAR lowqrtl : DblDyneVec; + VAR hiqrtl : DblDyneVec; + VAR tenpcnt : DblDyneVec; + VAR ninetypcnt : DblDyneVec; + VAR means : DblDyneVec; + VAR median : DblDyneVec); + + public + { public declarations } + end; + +var + BoxPlotFrm: TBoxPlotFrm; + +implementation + +uses + Math; + +{ TBoxPlotFrm } + +procedure TBoxPlotFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + GroupEdit.Text := ''; + MeasEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TBoxPlotFrm.VarListClick(Sender: TObject); +var + index: integer; + +begin + index := VarList.ItemIndex; + if index > -1 then + begin + if (GroupEdit.Text = '') then + GroupEdit.Text := VarList.Items[index] + else + MeasEdit.Text := VarList.Items[index]; + end; +end; + +procedure TBoxPlotFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TBoxPlotFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, GrpVar, MeasVar, mingrp, maxgrp, G, NoGrps, cnt : integer; + nscrgrps : integer; + X, tenpcnt, ninepcnt, qrtile1, qrtile2, qrtile3 : double; + minscr, maxscr, intvlsize, lastX : double; + cellstring: string; + means, lowqrtl, hiqrtl, tenpcntile, ninetypcntile, median : DblDyneVec; + freq : DblDyneVec; + Scores : DblDyneVec; + cumfreq : DblDyneVec; + prank : DblDyneVec; + grpsize : IntDyneVec; + scrgrp : DblDyneVec; + done : boolean; + NoSelected : integer; + ColNoSelected : IntDyneVec; + lReport: TStrings; +begin + lReport := TStringList.Create; + try + lReport.Add('BOX PLOTS OF GROUPS'); + lReport.Add(''); + + GrpVar := 0; + MeasVar := 0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = GroupEdit.Text then GrpVar := i; + if cellstring = MeasEdit.Text then MeasVar := i; + end; + if GrpVar = 0 then + begin + MessageDlg('Group variable not selected.', mtError, [mbOK], 0); + exit; + end; + if MeasVar = 0 then + begin + MessageDlg('Measurement variable not selected.', mtError, [mbOK], 0); + exit; + end; + + NoSelected := 2; + SetLength(ColNoSelected, NoSelected); + ColNoSelected[0] := GrpVar; + ColNoSelected[1] := MeasVar; + + // get minimum and maximum group values + mingrp := 10000; + maxgrp := -10000; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + G := round(StrToFloat(OS3MainFrm.DataGrid.Cells[GrpVar,i])); + if G < mingrp then mingrp := G; + if G > maxgrp then maxgrp := G; + end; + NoGrps := maxgrp - mingrp + 1; + if NoGrps > 30 then + begin + MessageDlg('Too many groups for meaningful plot.', mtError, [mbOK], 0); + exit; + end; + + SetLength(freq,2 * NoCases + 1); + SetLength(Scores,2 * NoCases + 1); + SetLength(cumfreq,2 * NoCases + 1); + SetLength(prank,2 * NoCases + 1); + + SetLength(grpsize,NoGrps+1); + SetLength(means,NoGrps+1); + SetLength(lowqrtl,NoGrps+1); + SetLength(hiqrtl,NoGrps+1); + SetLength(tenpcntile,NoGrps+1); + SetLength(ninetypcntile,NoGrps+1); + SetLength(median,NoGrps+1); + SetLength(scrgrp,NoGrps+1); + + // initialize + for j := 1 to NoGrps do + begin + means[j-1] := 0.0; + grpsize[j-1] := 0; + end; + + // get minimum and maximum scores and score interval + intvlsize := 10000.0; + lastX := 0.0; + X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar,1]); + minscr := X; + maxscr := X; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar,i]); + if X > maxscr then maxscr := X; + if X < minscr then minscr := X; + if i > 1 then // get interval size as minimum difference between 2 scores + begin + if (X <> lastX) and (abs(X - lastX) < intvlsize) then + intvlsize := abs(X - lastX); + lastX := X; + end else + lastX := X; + end; + + // check for excess no. of intervals and reset if needed + nscrgrps := round((maxscr - minscr) / intvlsize); + if nscrgrps > 2 * NoCases then + intvlsize := (maxscr - minscr) / NoCases; + + // setup score groups + done := false; + Scores[0] := minscr - intvlsize / 2.0; + nscrgrps := 0; + lastX := maxscr + intvlsize + intvlsize / 2.0; + + while not done do + begin + nscrgrps := nscrgrps + 1; + Scores[nscrgrps] := minscr + (nscrgrps * intvlsize) - intvlsize / 2.0; + if Scores[nscrgrps] > lastX then done := true; + end; + Scores[nscrgrps+1] := Scores[nscrgrps] + intvlsize; + if Scores[0] < minscr then minscr := Scores[0]; + if Scores[nscrgrps] > maxscr then maxscr := Scores[nscrgrps]; + + // do analysis for each group + for j := 1 to NoGrps do // group + begin + // get score groups for this group j + for i := 0 to nscrgrps do + begin + cumfreq[i] := 0.0; + freq[i] := 0.0; + end; + cnt := 0; + for i := 1 to NoCases do + begin // get scores for this group j + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + G := round(StrToFloat(OS3MainFrm.DataGrid.Cells[GrpVar,i])); + G := G - mingrp + 1; + if G = j then // subject in this group + begin + cnt := cnt + 1; + X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar,i]); + means[j-1] := means[j-1] + X; + // find score interval and add to the frequency + for k := 0 to nscrgrps do + if (X >= Scores[k]) and (X < Scores[k+1]) then + freq[k] := freq[k] + 1; + end; + end; + grpsize[j-1] := cnt; + if grpsize[j-1] > 0 then means[j-1] := means[j-1] / grpsize[j-1]; + + // accumulate frequencies + cumfreq[0] := freq[0]; + for i := 1 to nscrgrps-1 do + cumfreq[i] := cumfreq[i-1] + freq[i]; + cumfreq[nscrgrps] := cumfreq[nscrgrps-1]; + + // get percentile ranks + prank[0] := ((cumfreq[0] / 2.0) / grpsize[j-1]) * 100.0; + for i := 1 to nscrgrps-1 do + prank[i] := ((cumfreq[i-1] + (freq[i] / 2.0)) / grpsize[j-1]) * 100.0; + + // get centiles required. + tenpcnt := 0.10 * grpsize[j-1]; + tenpcntile[j-1] := Percentile(nscrgrps,tenpcnt,freq,cumfreq,scores); + ninepcnt := 0.90 * grpsize[j-1]; + ninetypcntile[j-1] := Percentile(nscrgrps,ninepcnt,freq,cumfreq,scores); + qrtile1 := 0.25 * grpsize[j-1]; + lowqrtl[j-1] := Percentile(nscrgrps,qrtile1,freq,cumfreq,scores); + qrtile2 := 0.50 * grpsize[j-1]; + median[j-1] := Percentile(nscrgrps,qrtile2,freq,cumfreq,scores); + qrtile3 := 0.75 * grpsize[j-1]; + hiqrtl[j-1] := Percentile(nscrgrps,qrtile3,freq,cumfreq,scores); + + if ShowChk.Checked then + begin + if j > 1 then lReport.Add(''); + lReport.Add('RESULTS FOR GROUP %d, MEAN = %.3f', [j, means[j-1]]); + lReport.Add(''); + lReport.Add('Centile Value'); + lReport.Add('------------ ------'); + lReport.Add('Ten %6.3f', [tenpcntile[j-1]]); + lReport.Add('Twenty five %6.3f', [lowqrtl[j-1]]); + lReport.Add('Median %6.3f', [median[j-1]]); + lReport.Add('Seventy five %6.3f', [hiqrtl[j-1]]); + lReport.Add('Ninety %6.3f', [ninetypcntile[j-1]]); + lReport.Add(''); + lReport.Add('Score Range Frequency Cum.Freq. Percentile Rank'); + lReport.Add('--------------- --------- --------- ---------------'); + for i := 0 to nscrgrps-1 do + lReport.Add('%6.2f - %6.2f %6.2f %6.2f %6.2f', [ + Scores[i], Scores[i+1], freq[i], cumfreq[i], prank[i] + ]); + lReport.Add(''); + end; + end; // get values for next group + + if ShowChk.Checked then + DisplayReport(lReport); + + // plot the boxes + BoxPlot(NoGrps, maxscr, minscr, lowqrtl, hiqrtl, tenpcntile, ninetypcntile, means, median); + + finally + lReport.Free; + + // Clean up + scrgrp := nil; + median := nil; + ninetypcntile := nil; + tenpcntile := nil; + hiqrtl := nil; + lowqrtl := nil; + means := nil; + grpsize := nil; + cumfreq := nil; + scores := nil; + freq := nil; + ColNoSelected := nil; + end; +end; + +procedure TBoxPlotFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TBoxPlotFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if BlankFrm = nil then Application.CreateForm(TBlankFrm, BlankFrm); +end; + +procedure TBoxPlotFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +function TBoxPlotFrm.Percentile(nscrgrps: integer; + pcnt: double; + var freq: DblDyneVec; + var cumfreq: DblDyneVec; + var scores: DblDyneVec) : double; +var + i, interval: integer; + pcntile, Llimit, Ulimit, cumlower, intvlfreq: double; +begin + interval := 0; + for i := 0 to nscrgrps-1 do + begin + if cumfreq[i] > pcnt then + begin + interval := i; + Break; + end; + end; + + if interval > 0 then + begin + Llimit := Scores[interval]; + Ulimit := Scores[interval+1]; + cumlower := cumfreq[interval-1]; + intvlfreq := freq[interval]; + end + else + begin // Percentile in first interval + Llimit := Scores[0]; + Ulimit := Scores[1]; + cumlower := 0.0; + intvlfreq := freq[0]; + end; + + if intvlfreq > 0 then + pcntile := Llimit + ((pcnt - cumlower) / intvlfreq) * (Ulimit- Llimit) + else + pcntile := Llimit; + + Result := pcntile; +end; +//------------------------------------------------------------------- + +{ +procedure TBoxPlotFrm.pBoxPlot(nbars : integer; + max, min : double; + VAR lowqrtl : DblDyneVec; + VAR hiqrtl : DblDyneVec; + VAR tenpcnt : DblDyneVec; + VAR ninetypcnt : DblDyneVec; + VAR means : DblDyneVec; + VAR median : DblDyneVec); +var + i, HTickSpace, imagewide, imagehi, vtop, vbottom, offset : integer; + vhi, hleft, hright, hwide, barwidth, Xpos, Ypos, strhi, strwide : integer; +// coords : array [1..5] of TPoint; + X, Y, colcycle : integer; + X1, X2, X3, X9, X10 : integer; // X coordinates for box and lines + Y1, Y2, Y3, Y4, Y9 : integer; // Y coordinates for box and lines + Title : string; + valincr, Yvalue : double; + +begin + Printer.Orientation := poLandscape; + Printer.BeginDoc; + Title := 'BOXPLOT FOR : ' + OS3MainFrm.FileNameEdit.Text; + imagewide := Printer.PageWidth; + imagehi := Printer.PageHeight; + vtop := 400; + vbottom := round(imagehi) - 400; +// vhi := vbottom - vtop; + hleft := 400; + hright := imagewide - 40; + hwide := hright - hleft; + + // show title + Printer.Canvas.Brush.Color := clWhite; + strhi := Printer.Canvas.TextWidth(Title) div 2; + strhi := imagewide div 2 - strhi; + Printer.Canvas.TextOut(strhi,50,Title); + + // show legend + Y := Printer.Canvas.TextHeight(Title) * 2; + Y := Y + 50; + Title := 'RED: mean, BLACK: median, BOX: 25th to 75th percentile, WISKERS: 10th and 90th percentile'; + X := imagewide div 2 - Printer.Canvas.TextWidth(Title) div 2; + Printer.Canvas.TextOut(X,Y,Title); + + Printer.Canvas.Pen.Color := clBlack; + Printer.Canvas.Brush.Color := clWhite; + + // Draw chart border + Printer.Canvas.Rectangle(hleft,vtop,hright,vbottom); + vbottom := vbottom - 400; // decrease bottom + vhi := vbottom - vtop; + + // Draw vertical axis + valincr := (max - min) / 20.0; + for i := 1 to 21 do + begin + Title := format('%8.2f',[max - ((i-1)*valincr)]); + strwide := Printer.Canvas.TextWidth(Title); + strhi := Printer.Canvas.TextHeight(Title); + xpos := 20 + hleft; + Yvalue := max - (valincr * (i-1)); + ypos := round(vhi * ( (max - Yvalue) / (max - min))); + ypos := ypos + vtop - strhi div 2; + Printer.Canvas.TextOut(xpos,ypos,Title); + end; + Printer.Canvas.MoveTo(hleft + strwide + 50,vtop); + Printer.Canvas.LineTo(hleft + strwide + 50,vbottom+20); + hwide := hwide - (strwide + 50); + hleft := hleft + strwide + 50; + HTickSpace := hwide div (nbars + 1); + barwidth := HTickSpace div 2; + + // draw horizontal axis + Printer.Canvas.MoveTo(hleft,vbottom + 20); + Printer.Canvas.LineTo(hright,vbottom + 20); + for i := 1 to nbars do + begin + ypos := vbottom + 10; + xpos := round((hwide / (nbars+1))* i + hleft); + Printer.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + Printer.Canvas.LineTo(xpos,ypos); + Title := format('%d',[i]); + offset := Printer.Canvas.TextWidth(Title) div 2; + strhi := Printer.Canvas.TextHeight(Title); + xpos := xpos - offset; + ypos := ypos + strhi; + Printer.Canvas.Pen.Color := clBlack; + Printer.Canvas.TextOut(xpos,ypos,Title); + xpos := hleft; + Printer.Canvas.TextOut(xpos,ypos,'GROUPS:'); + end; + + for i := 1 to nbars do + begin + colcycle := i mod 4; // select a color for box + if (colcycle = 0) then Printer.Canvas.Brush.Color := clBlue; + if (colcycle = 1) then Printer.Canvas.Brush.Color := clGreen; + if (colcycle = 2) then Printer.Canvas.Brush.Color := clFuchsia; + if (colcycle = 3) then Printer.Canvas.Brush.Color := clLime; + + // plot the box front face + X9 := round(hleft + ((i) * HTickSpace) - (barwidth / 2)); + X10 := X9 + barwidth; + X1 := X9; + X2 := X10; + Ypos:= round((((max - hiqrtl[i-1]) / (max - min)) * vhi) + vtop); + Y1 := Ypos; + Ypos := round((((max - lowqrtl[i-1]) / (max - min)) * vhi) + vtop); + Y2 := Ypos; + Printer.Canvas.Rectangle(X1,Y1,X2,Y2); + + // draw upper 90th percentile line and end + X3 := round(X1 + barwidth / 2); + Printer.Canvas.MoveTo(X3,Y1); + Ypos := round((((max - ninetypcnt[i-1]) / (max - min)) * vhi) + vtop); + Y3 := Ypos; + Printer.Canvas.LineTo(X3,Y3); + Printer.Canvas.MoveTo(X1,Y3); + Printer.Canvas.LineTo(X2,Y3); + + // draw lower 10th percentile line and end + Printer.Canvas.MoveTo(X3,Y2); + Ypos := round((((max - tenpcnt[i-1]) / (max - min)) * vhi) + vtop); + Y4 := Ypos; + Printer.Canvas.LineTo(X3,Y4); + Printer.Canvas.MoveTo(X1,Y4); + Printer.Canvas.LineTo(X2,Y4); + + //plot the mean line + Printer.Canvas.Pen.Width := 10; + Printer.Canvas.Pen.Color := clRed; + Printer.Canvas.Pen.Style := psDot; + Ypos := round((((max - means[i-1]) / (max - min)) * vhi) + vtop); + Y9 := Ypos; + Printer.Canvas.MoveTo(X9,Y9); + Printer.Canvas.LineTo(X10,Y9); + Printer.Canvas.Pen.Color := clBlack; + Printer.Canvas.Pen.Style := psSolid; + + //plot the median line + Printer.Canvas.Pen.Color := clBlack; + Ypos := round((((max - median[i-1]) / (max - min)) * vhi) + vtop); + Y9 := Ypos; + Printer.Canvas.MoveTo(X9,Y9); + Printer.Canvas.LineTo(X10,Y9); + Printer.Canvas.Pen.Color := clBlack; + + end; + Printer.EndDoc; + Printer.Orientation := poPortrait; +end; +} + +//-------------------------------------------------------------------------- + +procedure TBoxPlotFrm.BoxPlot(nbars: integer; + max, min: double; + var lowqrtl: DblDyneVec; + var hiqrtl: DblDyneVec; + var tenpcnt: DblDyneVec; + var ninetypcnt: DblDyneVec; + var means: DblDyneVec; + var median: DblDyneVec); +const + BOX_COLORS: Array[0..3] of TColor = (clBlue, clGreen, clFuchsia, clLime); +var + i, HTickSpace, imagewide, imagehi, vtop, vbottom, offset: integer; + vhi, hleft, hright, hwide, barwidth, Xpos, Ypos, strhi: integer; + XOffset, YOffset: integer; + X, Y: integer; + X1, X2, X3, X9, X10: integer; // X coordinates for box and lines + Y1, Y2, Y3, Y4, Y9: integer; // Y coordinates for box and lines + Title: string; + valincr, Yvalue: double; +begin + BlankFrm.Show; + //BlankFrm.Image1.Canvas.Clear; + + imagewide := BlankFrm.Image1.width; + imagehi := BlankFrm.Image1.Height; + XOffset := imagewide div 10; + YOffset := imagehi div 10; + + vtop := YOffset; + vbottom := imagehi - YOffset; + vhi := vbottom - vtop; + hleft := XOffset; + hright := imagewide - hleft - XOffset; + hwide := hright - hleft; + HTickSpace := hwide div nbars; + barwidth := HTickSpace div 2; + + + // Show title + Title := 'BOXPLOT FOR : ' + OS3MainFrm.FileNameEdit.Text; + BlankFrm.Caption := Title; +(* + // show legend + Y := BlankFrm.Image1.Canvas.TextHeight(Title) * 2; + Y := Y + vtop; + Title := 'RED: mean, BLACK: median, BOX: 25th to 75th percentile, WISKERS: 10th and 90th percentile'; + X := imagewide div 2 - BlankFrm.Canvas.TextWidth(Title) div 2; + BlankFrm.Image1.Canvas.TextOut(X,Y,Title); + *) + + // Draw chart background and border + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Rectangle(0,0,imagewide,imagehi); + + // show legend + Y := 2; + Title := 'RED: mean, BLACK: median, BOX: 25th to 75th percentile, WISKERS: 10th and 90th percentile'; + X := imagewide div 2 - BlankFrm.Canvas.TextWidth(Title) div 2; + BlankFrm.Image1.Canvas.TextOut(X,Y,Title); + + // Draw vertical axis + valincr := (max - min) / 20.0; + for i := 1 to 21 do + begin + Title := format('%8.2f',[max - ((i-1)*valincr)]); + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := XOffset; + Yvalue := max - (valincr * (i-1)); + ypos := round(vhi * ( (max - Yvalue) / (max - min))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + BlankFrm.Image1.Canvas.MoveTo(hleft,vtop); + BlankFrm.Image1.Canvas.LineTo(hleft,vbottom); + + // draw horizontal axis + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 10 ); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom + 10); + for i := 1 to nbars do + begin + ypos := vbottom + 10; + xpos := round((hwide / nbars)* i + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := format('%d',[i]); + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := xpos - offset; + ypos := ypos + strhi - 2; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + xpos := 20; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:'); + end; + + for i := 1 to nbars do + begin + BlankFrm.Image1.Canvas.Brush.Color := BOX_COLORS[i mod 4]; + + // plot the box front face + X9 := round(hleft + ((i) * HTickSpace) - (barwidth / 2)); + X10 := X9 + barwidth; + X1 := X9; + X2 := X10; + Y1 := round((((max - hiqrtl[i-1]) / (max - min)) * vhi) + vtop); + Y2 := round((((max - lowqrtl[i-1]) / (max - min)) * vhi) + vtop); + BlankFrm.Image1.Canvas.Rectangle(X1,Y1,X2,Y2); + + // draw upper 90th percentile line and end + X3 := round(X1 + barwidth / 2); + BlankFrm.Image1.Canvas.MoveTo(X3,Y1); + Y3 := round((((max - ninetypcnt[i-1]) / (max - min)) * vhi) + vtop); + BlankFrm.Image1.Canvas.LineTo(X3,Y3); + BlankFrm.Image1.Canvas.MoveTo(X1,Y3); + BlankFrm.Image1.Canvas.LineTo(X2,Y3); + + // draw lower 10th percentile line and end + BlankFrm.Image1.Canvas.MoveTo(X3,Y2); + Y4 := round((((max - tenpcnt[i-1]) / (max - min)) * vhi) + vtop); + BlankFrm.Image1.Canvas.LineTo(X3,Y4); + BlankFrm.Image1.Canvas.MoveTo(X1,Y4); + BlankFrm.Image1.Canvas.LineTo(X2,Y4); + + //plot the means line + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.Pen.Style := psDot; + Y9 := round((((max - means[i-1]) / (max - min)) * vhi) + vtop); + BlankFrm.Image1.Canvas.MoveTo(X9,Y9); + BlankFrm.Image1.Canvas.LineTo(X10,Y9); + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Pen.Style := psSolid; + + //plot the median line + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + Y9 := round((((max - median[i-1]) / (max - min)) * vhi) + vtop); + BlankFrm.Image1.Canvas.MoveTo(X9,Y9); + BlankFrm.Image1.Canvas.LineTo(X10,Y9); + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + end; +end; + + +initialization + {$I boxplotunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/breakdownunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/breakdownunit.lfm new file mode 100644 index 000000000..db37affaf --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/breakdownunit.lfm @@ -0,0 +1,305 @@ +object BreakDownFrm: TBreakDownFrm + Left = 400 + Height = 367 + Top = 248 + Width = 428 + AutoSize = True + Caption = 'Breakdown' + ClientHeight = 367 + ClientWidth = 428 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CheckGroup1: TCheckGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 51 + Top = 267 + Width = 140 + Anchors = [akLeft, akBottom] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Option' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 31 + ClientWidth = 136 + Items.Strings = ( + 'One Way ANOVA' + ) + TabOrder = 1 + Data = { + 0100000002 + } + end + object Panel2: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CheckGroup1 + Left = 8 + Height = 251 + Top = 8 + Width = 412 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 251 + ClientWidth = 412 + Constraints.MinHeight = 200 + TabOrder = 0 + object AvailLabel: TLabel + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Panel2 + Left = 0 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Available Variables' + ParentColor = False + end + object AnalLabel: TLabel + AnchorSideLeft.Control = SelList + AnchorSideTop.Control = Panel2 + Left = 228 + Height = 15 + Top = 0 + Width = 104 + Caption = 'Variables to Analyze' + ParentColor = False + end + object SelLabel: TLabel + AnchorSideLeft.Control = SelList + AnchorSideBottom.Control = DepVar + Left = 228 + Height = 15 + Top = 199 + Width = 153 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Selected Continuous Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = AvailLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 234 + Top = 17 + Width = 184 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object SelList: TListBox + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = AnalLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = SelVarInBtn + Left = 228 + Height = 166 + Top = 17 + Width = 184 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + OnSelectionChange = SelListSelectionChange + TabOrder = 3 + end + object DepVar: TEdit + AnchorSideLeft.Control = SelList + AnchorSideTop.Control = SelLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = SelList + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = SelVarOutBtn + AnchorSideBottom.Side = asrBottom + Left = 228 + Height = 23 + Top = 216 + Width = 184 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'DepVar' + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 192 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 192 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object SelVarInBtn: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = SelVarOutBtn + Left = 192 + Height = 28 + Top = 191 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = SelVarInBtnClick + Spacing = 0 + TabOrder = 4 + end + object SelVarOutBtn: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 192 + Height = 28 + Top = 223 + Width = 28 + Anchors = [akLeft, akBottom] + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = SelVarOutBtnClick + Spacing = 0 + TabOrder = 5 + end + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 361 + Height = 25 + Top = 334 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 4 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 215 + Height = 25 + Top = 334 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object HelpBtn: TButton + Tag = 109 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 156 + Height = 25 + Top = 334 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 2 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 318 + Width = 428 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 277 + Height = 25 + Top = 334 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/breakdownunit.pas b/applications/lazstats/source/forms/analysis/descriptive/breakdownunit.pas new file mode 100644 index 000000000..69347a5ea --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/breakdownunit.pas @@ -0,0 +1,666 @@ +// Use "twoway.laz" for testing + +unit BreakDownUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, + MainUnit, Globals, FunctionsLib, OutputUnit, DataProcs, ContextHelpUnit; + +type + + { TBreakDownFrm } + + TBreakDownFrm = class(TForm) + Bevel1: TBevel; + ComputeBtn: TButton; + HelpBtn: TButton; + InBtn: TBitBtn; + OutBtn: TBitBtn; + Panel2: TPanel; + SelVarInBtn: TBitBtn; + SelVarOutBtn: TBitBtn; + ResetBtn: TButton; + CloseBtn: TButton; + CheckGroup1: TCheckGroup; + DepVar: TEdit; + AvailLabel: TLabel; + AnalLabel: TLabel; + SelLabel: TLabel; + SelList: TListBox; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure SelListSelectionChange(Sender: TObject; User: boolean); + procedure SelVarInBtnClick(Sender: TObject); + procedure SelVarOutBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + + private + { private declarations } + FAutoSized: Boolean; + Minimum, Maximum, levels, displace, subscript : IntDyneVec; + Freq : IntDyneVec; + Selected : IntDyneVec; + mean, variance, Stddev, SS : DblDyneVec; + index, NoSelected, ListSize, Dependentvar, X, length_array : integer; + ptr1, ptr2, sum, grandsum : integer; + xsumtotal, xsqrtotal, grandsumx, grandsumx2, value, SD : double; + SST, SSW, SSB, MSW, MSB, F, FProb, DF1, DF2 : double; + cellstring : string; + outline : string; + valstr : string; + dataread : boolean; + function Index_Pos(var X1: IntDyneVec; var displace1: IntDyneVec; ListSize1: integer): Integer; + procedure UpdateBtnStates; + + public + { public declarations } + end; + +var + BreakDownFrm: TBreakDownFrm; + +implementation + +uses + Math; + +{ TBreakDownFrm } + +procedure TBreakDownFrm.ResetBtnClick(Sender: TObject); +var + i: integer; + +begin + VarList.Clear; + SelList.Clear; + DepVar.Text := ''; + InBtn.Enabled := true; + OutBtn.Enabled := false; + SelVarInBtn.Enabled := true; + SelVarOutBtn.Enabled := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TBreakDownFrm.SelListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TBreakDownFrm.SelVarInBtnClick(Sender: TObject); +var + index1 : integer; +begin + index1 := VarList.ItemIndex; + if (index1 > -1) and (DepVar.Text = '') then + begin + DepVar.Text := VarList.Items[index1]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TBreakDownFrm.SelVarOutBtnClick(Sender: TObject); +begin + if DepVar.Text <> '' then + VarList.Items.Add(DepVar.Text); + UpdateBtnStates; +end; + +procedure TBreakDownFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TBreakDownFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TBreakDownFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + //Panel2.Constraints.MinWidth := SelLabel.Width * 2 + InBtn.Width + 2 * VarList.BorderSpacing.Right; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TBreakDownFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TBreakDownFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TBreakDownFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if (VarList.Selected[i]) then + begin + SelList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TBreakDownFrm.ComputeBtnClick(Sender: TObject); +label + Label1, Label3, Label4, NextStep, FirstOne, SecondOne, ThirdOne, LastStep; +var + i, j: integer; + tempval: string; + lReport: TStrings; +begin + // Identify columns of variables to analyze and the dependent var. + NoSelected := SelList.Items.Count; + + if NoSelected = 0 then + begin + MessageDlg('No variables selected.', mtError, [mbOK], 0); + exit; + end; + + // Get column no. of dependent variable + dependentVar := 0; + cellstring := DepVar.Text; + for i := 1 to NoVariables do + if cellstring = OS3MainFrm.DataGrid.Cells[i,0] then dependentvar := i; + + if dependentVar = 0 then + begin + MessageDlg('Continuous variable is not specified.', mtError, [mbOK], 0); + exit; + end; + + // Allocate heap + SetLength(Minimum,NoVariables); + SetLength(Maximum,NoVariables); + SetLength(levels,NoVariables); + SetLength(displace,NoVariables); + SetLength(subscript,NoVariables); + SetLength(Selected,NoVariables); + + // Get selected variables + for i := 1 to NoSelected do + begin + cellstring := SelList.Items.Strings[i-1]; + for j := 1 to NoVariables do + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then Selected[i-1] := j; + end; + Selected[NoSelected] := dependentvar; + ListSize := NoSelected; + + // Get maximum and minimum levels in each variable + for i := 1 to ListSize do + begin + index := Selected[i-1]; + Minimum[i-1] := round(StrToFloat(OS3MainFrm.DataGrid.Cells[index,1])); + Maximum[i-1] := Minimum[i-1]; + for j := 1 to NoCases do + begin + if GoodRecord(j,NoSelected,Selected) then + begin + X := round(StrToFloat(OS3MainFrm.DataGrid.Cells[index,j])); + if X < Minimum[i-1] then Minimum[i-1] := X; + if X > Maximum[i-1] then Maximum[i-1] := X; + end; + end; + end; + + // Calculate number of levels for each variable + for i := 1 to ListSize do + levels[i-1] := Maximum[i-1] - Minimum[i-1] + 1; + displace[ListSize-1] := 1; + if ListSize > 1 then + for i := ListSize-1 downto 1 do + displace[i-1] := levels[i] * displace[i]; + + // Now, tabulate + length_array := 1; + for i := 1 to ListSize do + length_array := Length_array * levels[i-1]; + + // initialize values + SetLength(Freq, length_array+1); + SetLength(mean, length_array+1); + SetLength(variance, length_array+1); + SetLength(Stddev, length_array+1); + SetLength(SS, length_array+1); + + for i := 0 to length_array do + begin + Freq[i] := 0; + mean[i] := 0.0; + variance[i] := 0.0; + Stddev[i] := 0.0; + SS[i] := 0.0; + end; + + // tabulate + for i := 1 to NoCases do + begin + dataread := false; + if GoodRecord(i,NoSelected,Selected) then + begin + for j := 1 to ListSize do + begin + index := Selected[j-1]; + X := round(StrToFLoat(OS3MainFrm.DataGrid.Cells[index,i])); + X := X - Minimum[j-1] + 1; + subscript[j-1] := X; + dataread := true; + end; + end; + if dataread then + begin + j := Index_Pos(subscript,displace,ListSize); + Freq[j] := Freq[j] + 1; + index := dependentvar; + tempval := Trim(OS3MainFrm.DataGrid.Cells[index,i]); + if tempval <> '' then + begin + value := StrToFloat(tempval); + mean[j] := mean[j] + value; + variance[j] := variance[j] + (value * value); + end; + end; + end; + + // setup the output + lReport := TStringList.Create; + try + lReport.Add('BREAKDOWN ANALYSIS PROGRAM'); + lReport.Add(''); + lReport.Add('VARIABLE SEQUENCE FOR THE BREAKDOWN:'); + for i := 1 to ListSize do + begin + index := Selected[i-1]; + lReport.Add('%-10s (Variable %3d) Lowest level = %2d Highest level = %2d', [ + OS3MainFrm.DataGrid.Cells[index,0],i, Minimum[i-1], Maximum[i-1] + ]); + end; + + // Breakdown the data + ptr1 := ListSize - 1; + ptr2 := ListSize; + for i := 1 to ListSize do + subscript[i-1] := 1; + sum := 0; + xsumtotal := 0.0; + xsqrtotal := 0.0; + grandsum := 0; + grandsumx := 0.0; + grandsumx2 := 0.0; + + Label1: + index := Index_Pos(subscript, displace, ListSize); + lReport.Add('Variable levels:'); + for i := 1 to ListSize do + begin + j := Selected[i-1]; + lReport.Add('%-10s level = %3d', [ + OS3MainFrm.DataGrid.Cells[j,0], Minimum[i-1] + subscript[i-1] - 1 + ]); + end; + lReport.Add(''); + + sum := sum + Freq[index]; + xsumtotal := xsumtotal + mean[index]; + xsqrtotal := xsqrtotal + variance[index]; + + lReport.Add('Freq. Mean Std. Dev.'); + outline := Format('%3d', [Freq[index]]); + if Freq[index] > 0 then + begin + valstr := Format(' %8.3f ',[mean[index] / Freq[index]]); + outline := outline + valstr; + end + else + outline := outline +' ******** '; + + if Freq[index] > 1 then + begin + SS[index] := variance[index]; + variance[index] := variance[index] - (mean[index] * mean[index] / Freq[index]); + variance[index] := variance[index] / (Freq[index] - 1); + Stddev[index] := sqrt(variance[index]); + valstr := Format('%8.3f ', [Stddev[index]]); + outline := outline + valstr; + end else + outline := outline + '********'; + + lReport.Add(outline); + lReport.Add(''); + + subscript[ptr2-1] := subscript[ptr2-1] + 1; + if subscript[ptr2-1] <= levels[ptr2-1] then goto Label1; + lReport.Add('Number of observations across levels = %d',[sum]); + if sum > 0 then + lReport.Add('Mean across levels = %8.3f',[ xsumtotal / sum]) + else + lReport.Add('Mean across levels = ********'); + + if sum > 1 then + begin + SD := sqrt( (xsqrtotal - (xsumtotal * xsumtotal) / sum) / (sum - 1)); + lReport.Add('Std. Dev. across levels = %8.3f', [SD]); + end else + lReport.Add('Std. Dev. across levels = *******'); + + lReport.Add(''); + lReport.Add('==============================================================='); + lReport.Add(''); + //OutputFrm.ShowModal; + //OutputFrm.Clear; + + grandsum := grandsum + sum; + grandsumx := grandsumx + xsumtotal; + grandsumx2 := grandsumx2 + xsqrtotal; + sum := 0; + xsumtotal := 0.0; + xsqrtotal := 0.0; + if ptr1 < 1 then + goto NextStep; + + subscript[ptr1-1] :=subscript[ptr1-1] + 1; + if subscript[ptr1-1] <= levels[ptr1-1] then + goto Label4; + + Label3: + ptr1 := ptr1 - 1; + if ptr1 < 1 then + goto NextStep; + if subscript[ptr1-1] > levels[ptr1-1] then + goto Label3; + + subscript[ptr1-1] := subscript[ptr1-1] + 1; + if subscript[ptr1-1] > levels[ptr1-1] then + goto Label3; + + Label4: + for i := ptr1+1 to ListSize do subscript[i-1] := 1; + ptr1 := ListSize - 1; + if ptr1 < 1 then goto + NextStep; + goto Label1; + + NextStep: + lReport.Add('Grand number of observations across all categories = %3d', [grandsum]); + if grandsum > 0 then + lReport.Add('Overall Mean = %8.3f', [grandsumx / grandsum]); + if grandsum > 1 then + begin + SD := sqrt((grandsumx2 - (grandsumx * grandsumx) / grandsum) / (grandsum - 1)); + lReport.Add('Overall standard deviation = %8.3f', [SD]); + end; + + lReport.Add(''); + lReport.Add('==============================================================='); + lReport.Add(''); + //OutputFrm.ShowModal; + //OutputFrm.Clear; + + // Do ANOVA's if requested + if CheckGroup1.CheckEnabled[0] then + begin + lReport.Add('ANALYSES OF VARIANCE SUMMARY TABLES'); + lReport.Add(''); + ptr1 := ListSize - 1; + ptr2 := ListSize; + for i := 1 to ListSize do subscript[i-1] := 1; + SSB := 0.0; + SSW := 0.0; + MSB := 0.0; + MSW := 0.0; + grandsum := 0; + grandsumx := 0.0; + grandsumx2 := 0.0; + DF1 := 0.0; + DF2 := 0.0; + + FirstOne: + index := Index_Pos(subscript, displace, ListSize); + if Freq[index] > 0 then + begin + lReport.Add('Variable levels: '); + for i := 1 to ListSize do + begin + j := Selected[i-1]; + lReport.Add('%-10s level = %3d', [ + OS3MainFrm.DataGrid.Cells[j,0], Minimum[i-1] + subscript[i-1] - 1 + ]); + end; + lReport.Add(''); + + // build sumsof squares for this set + DF1 := DF1 + 1; + DF2 := DF2 + Freq[index] - 1; + grandsum := grandsum + Freq[index]; + grandsumx := grandsumx + mean[index]; + grandsumx2 := grandsumx2 + SS[index]; + SSW := SSW + SS[index] - (mean[index] * mean[index] / Freq[index]); + end; + subscript[ptr2-1] := subscript[ptr2-1] + 1; + if subscript[ptr2-1] <= levels[ptr2-1] then + goto FirstOne; + + if ((grandsum > 0.0) and (DF1 > 1) and (DF2 > 1) and (SSW > 0.0)) then + begin + // build and show anova table + SST := grandsumx2 - (grandsumx * grandsumx / grandsum); + SSB := SST - SSW; + DF1 := DF1 - 1.0; // no. of groups - 1 + MSB := SSB / DF1; + MSW := SSW / DF2; + F := MSB / MSW; + FProb := probf(DF1,DF2,F); + lReport.Add('SOURCE D.F. SS MS F Prob.>F'); + lReport.Add('GROUPS %2.0f %8.2f %8.2f %8.3f %6.4f', [DF1,SSB,MSB,F,FProb]); + lReport.Add('WITHIN %2.0f %8.2f %8.2f', [DF2,SSW,MSW]); + lReport.Add('TOTAL %2d %8.2f', [grandsum-1,SST]); + //OutputFrm.ShowModal; + //OutputFrm.Clear; + end else + begin + lReport.Add('Insufficient data for ANOVA'); + //OutputFrm.ShowModal; + //OutputFrm.Clear; + end; + lReport.Add(''); + lReport.Add('============================================================='); + lReport.Add(''); + + SSB := 0.0; + SSW := 0.0; + MSB := 0.0; + MSW := 0.0; + grandsum := 0; + grandsumx := 0.0; + grandsumx2 := 0.0; + DF1 := 0.0; + DF2 := 0.0; + if ptr1 < 1 then + goto LastStep; + + subscript[ptr1-1] := subscript[ptr1-1] + 1; + if subscript[ptr1-1] <= levels[ptr1-1] then + goto ThirdOne; + + SecondOne: + ptr1 := ptr1 - 1; + if ptr1 < 1 then goto LastStep; + if subscript[ptr1-1] > levels[ptr1-1] then + goto SecondOne; + + subscript[ptr1-1] := subscript[ptr1-1] + 1; + if subscript[ptr1-1] > levels[ptr1-1] then + goto SecondOne; + + ThirdOne: + for i := ptr1+1 to ListSize do subscript[i-1] := 1; + ptr1 := ListSize - 1; + if ptr1 < 1 then + goto LastStep; + + goto FirstOne; + + LastStep: + // do anova for all cells + lReport.Add('ANOVA FOR ALL CELLS'); + lReport.Add(''); + SST := 0.0; + SSW := 0.0; + DF2 := 0.0; + DF1 := 0.0; + grandsumx := 0.0; + grandsum := 0; + for i := 1 to length_array do + begin + if Freq[i] > 0 then + begin + SST := SST + SS[i]; + grandsum := grandsum + Freq[i]; + grandsumx := grandsumx + mean[i]; + SSW := SSW + (SS[i] - (mean[i] * mean[i] / Freq[i])); + DF1 := DF1 + 1.0; + DF2 := DF2 + (Freq[i] - 1); + end; + end; + + if ( (DF1 > 1.0) and (DF2 > 1.0) and (SSW > 0.0)) then + begin + SST := SST - (grandsumx * grandsumx / grandsum); + SSB := SST - SSW; + DF1 := DF1 - 1; + MSB := SSB / DF1; + MSW := SSW / DF2; + F := MSB / MSW; + FProb := probf(DF1, DF2, F); + lReport.Add('SOURCE D.F. SS MS F Prob.>F'); + lReport.Add('GROUPS %2.0f %8.2f %8.2f %8.3f %6.4f', [DF1, SSB, MSB, F, FProb]); + lReport.Add('WITHIN %2.0f %8.2f %8.2f', [DF2, SSW, MSW]); + lReport.Add('TOTAL %2d %8.2f', [grandsum-1, SST]); + lReport.Add('FINISHED'); + end else + begin + lReport.Add('Only 1 group. No ANOVA possible.'); + end; + end; + + // Show report in output form + DisplayReport(lReport); + + finally + lReport.Free; + + SS := nil; + Stddev := nil; + variance := nil; + mean := nil; + Freq := nil; + selected := nil; + subscript := nil; + displace := nil; + levels := nil; + Maximum := nil; + Minimum := nil; + end; +end; + +procedure TBreakDownFrm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < SelList.Items.Count do + begin + if (SelList.Selected[i]) then + begin + VarList.Items.Add(SelList.Items[i]); + SelList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +function TBreakDownFrm.Index_Pos(var X1: IntDyneVec; var displace1: IntDyneVec; + ListSize1: integer): integer; +var + i: integer; +begin + Result := X1[ListSize-1]; + for i := 1 to ListSize - 1 do + Result := Result + ((X1[i-1] - 1) * displace[i-1]); +end; + +procedure TBreakDownFrm.UpdateBtnStates; +var + lSelected: Boolean; + i: Integer; +begin + lSelected := false; + for i := 0 to VarList.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + InBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to SelList.Count-1 do + if SelList.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; + + SelVarInBtn.Enabled := (VarList.ItemIndex > -1) and (DepVar.Text = ''); + SelVarOutBtn.Enabled := (DepVar.Text <> ''); +end; + +initialization + {$I breakdownunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/bubbleplotunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/bubbleplotunit.lfm new file mode 100644 index 000000000..d6d7d8e44 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/bubbleplotunit.lfm @@ -0,0 +1,486 @@ +object BubbleForm: TBubbleForm + Left = 473 + Height = 454 + Top = 253 + Width = 500 + AutoSize = True + Caption = 'Repeated Measures Bubble Plot' + ClientHeight = 454 + ClientWidth = 500 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label6: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = TitleEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 316 + Width = 55 + BorderSpacing.Left = 8 + Caption = 'Main Title:' + ParentColor = False + end + object Label7: TLabel + AnchorSideTop.Control = XLabelEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = XLabelEdit + Left = 22 + Height = 15 + Top = 347 + Width = 41 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'X Label:' + ParentColor = False + end + object Label8: TLabel + AnchorSideTop.Control = YLabelEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = YLabelEdit + Left = 293 + Height = 15 + Top = 347 + Width = 41 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Y Label:' + ParentColor = False + end + object TitleEdit: TEdit + AnchorSideLeft.Control = Label6 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = XLabelEdit + Left = 71 + Height = 23 + Top = 312 + Width = 421 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 8 + TabOrder = 1 + TextHint = 'Title of the Diagram' + end + object XLabelEdit: TEdit + AnchorSideLeft.Control = TitleEdit + AnchorSideBottom.Control = TransformChk + Left = 71 + Height = 23 + Top = 343 + Width = 150 + Anchors = [akLeft, akBottom] + TabOrder = 2 + TextHint = 'X Axis Title' + end + object YLabelEdit: TEdit + AnchorSideTop.Control = XLabelEdit + AnchorSideRight.Control = TitleEdit + AnchorSideRight.Side = asrBottom + Left = 342 + Height = 23 + Top = 343 + Width = 150 + Anchors = [akTop, akRight] + TabOrder = 3 + TextHint = 'Y Axis Title' + end + object TransformChk: TCheckBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 19 + Top = 378 + Width = 365 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + BorderSpacing.Bottom = 8 + Caption = 'Transform Data Grid for ANOVA (Treatments by Subjects ANOVA)' + TabOrder = 4 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = TitleEdit + Left = 8 + Height = 296 + Top = 8 + Width = 484 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 296 + ClientWidth = 484 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 49 + Caption = 'Variables:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = BubbleEdit + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = BubbleEdit + Left = 264 + Height = 15 + Top = 23 + Width = 201 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Bubble Identification Number Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = XEdit + AnchorSideBottom.Control = XEdit + Left = 264 + Height = 15 + Top = 97 + Width = 82 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'X Value Variable' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = YEdit + AnchorSideBottom.Control = YEdit + Left = 264 + Height = 15 + Top = 171 + Width = 82 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Y Value Variable' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = SizeEdit + AnchorSideBottom.Control = SizeEdit + Left = 264 + Height = 15 + Top = 245 + Width = 104 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Bubble Size Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = IDInBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 279 + Top = 17 + Width = 220 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object IDInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 228 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = IDInBtnClick + Spacing = 0 + TabOrder = 1 + end + object IDOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = IDInBtn + AnchorSideTop.Side = asrBottom + Left = 228 + Height = 28 + Top = 47 + Width = 28 + BorderSpacing.Top = 2 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = IDOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object XInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = IDOutBtn + AnchorSideTop.Side = asrBottom + Left = 228 + Height = 28 + Top = 91 + Width = 28 + BorderSpacing.Top = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = XInBtnClick + Spacing = 0 + TabOrder = 4 + end + object XOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = XInBtn + AnchorSideTop.Side = asrBottom + Left = 228 + Height = 28 + Top = 121 + Width = 28 + BorderSpacing.Top = 2 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = XOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object YInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = XOutBtn + AnchorSideTop.Side = asrBottom + Left = 228 + Height = 28 + Top = 165 + Width = 28 + BorderSpacing.Top = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = YInBtnClick + Spacing = 0 + TabOrder = 7 + end + object YOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = YInBtn + AnchorSideTop.Side = asrBottom + Left = 228 + Height = 28 + Top = 195 + Width = 28 + BorderSpacing.Top = 2 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = YOutBtnClick + Spacing = 0 + TabOrder = 8 + end + object SizeInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = YOutBtn + AnchorSideTop.Side = asrBottom + Left = 228 + Height = 28 + Top = 239 + Width = 28 + BorderSpacing.Top = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = SizeInBtnClick + Spacing = 0 + TabOrder = 10 + end + object SizeOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = SizeInBtn + AnchorSideTop.Side = asrBottom + Left = 228 + Height = 28 + Top = 269 + Width = 28 + BorderSpacing.Top = 2 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = SizeOutBtnClick + Spacing = 0 + TabOrder = 11 + end + object BubbleEdit: TEdit + AnchorSideLeft.Control = IDInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = IDOutBtn + AnchorSideBottom.Side = asrBottom + Left = 264 + Height = 23 + Top = 40 + Width = 220 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'BubbleEdit' + end + object XEdit: TEdit + AnchorSideLeft.Control = BubbleEdit + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = XOutBtn + AnchorSideBottom.Side = asrBottom + Left = 264 + Height = 23 + Top = 114 + Width = 220 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'XEdit' + end + object YEdit: TEdit + AnchorSideLeft.Control = BubbleEdit + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = YOutBtn + AnchorSideBottom.Side = asrBottom + Left = 264 + Height = 23 + Top = 188 + Width = 220 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 9 + Text = 'YEdit' + end + object SizeEdit: TEdit + AnchorSideLeft.Control = BubbleEdit + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = SizeOutBtn + AnchorSideBottom.Side = asrBottom + Left = 264 + Height = 23 + Top = 262 + Width = 220 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 12 + Text = 'SizeEdit' + end + end + object ReturnBtn: TButton + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 427 + Height = 25 + Top = 421 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 8 + end + object ComputeBtn: TButton + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 343 + Height = 25 + Top = 421 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 7 + end + object ResetBtn: TButton + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 281 + Height = 25 + Top = 421 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 6 + end + object HelpBtn: TButton + Tag = 110 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 222 + Height = 25 + Top = 421 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 5 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 405 + Width = 500 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/bubbleplotunit.pas b/applications/lazstats/source/forms/analysis/descriptive/bubbleplotunit.pas new file mode 100644 index 000000000..df96ae4de --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/bubbleplotunit.pas @@ -0,0 +1,628 @@ +// Use file "bubbleplot2.laz" for testing. + +unit BubblePlotUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Clipbrd, Buttons, ExtCtrls, Math, + MainUnit, Globals, OutputUnit, DataProcs, DictionaryUnit, ContextHelpUnit; + + +type + + { TBubbleForm } + + TBubbleForm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Panel1: TPanel; + TransformChk: TCheckBox; + YLabelEdit: TEdit; + Label8: TLabel; + XLabelEdit: TEdit; + Label7: TLabel; + TitleEdit: TEdit; + Label6: TLabel; + ResetBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + IDInBtn: TBitBtn; + IDOutBtn: TBitBtn; + XInBtn: TBitBtn; + XOutBtn: TBitBtn; + YInBtn: TBitBtn; + YOutBtn: TBitBtn; + SizeInBtn: TBitBtn; + SizeOutBtn: TBitBtn; + BubbleEdit: TEdit; + SizeEdit: TEdit; + YEdit: TEdit; + XEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure IDInBtnClick(Sender: TObject); + procedure IDOutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure SizeInBtnClick(Sender: TObject); + procedure SizeOutBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + procedure XInBtnClick(Sender: TObject); + procedure XOutBtnClick(Sender: TObject); + procedure YInBtnClick(Sender: TObject); + procedure YOutBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + BubbleForm: TBubbleForm; + +implementation + +uses + BlankFrmUnit; + +{ TBubbleForm } + +procedure TBubbleForm.IDInBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while (BubbleEdit.Text = '') and (i < VarList.Items.Count) do + begin + if (VarList.Selected[i]) then + begin + BubbleEdit.Text := VarList.Items[i]; + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TBubbleForm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TBubbleForm.ComputeBtnClick(Sender: TObject); +var + BubbleCol, XCol, YCol, SizeCol, i, j, LabelWide, TextHi, Xpos: integer; + ImageWide, ImageHi, Xstart, Xend, Ystart, Yend, Yincr, cell: integer; + Xmin, Xmax, Xrange, Xstep, intcell, noreplications, minrep, maxrep: integer; + nobubbles, yprop: integer; + varname, Xlabel, Ylabel, astring, Title: string; + Ymin, Ymax, Yrange, Ystep, cellvalue, xvalue: double; + BubMin, BubMax, BubRange, ratio, value: double; + valstr: string; + BubColor, place: integer; + X1, Y1, X2, Y2: integer; + dx, dy: Integer; + Data: DblDyneMat; + ncases, ncols, BubbleID, newcol : integer; + GrandYMean, GrandSizeMean, sizevalue, yvalue: double; + Ymeans: DblDyneVec; + CaseYMeans: DblDyneVec; + SizeMeans: DblDyneVec; + CaseSizeMeans: DblDyneVec; + outline: string; + labels: StrDyneVec; + lReport: TStrings; +begin + BubbleCol := 0; + XCol := 0; + YCol := 0; + SizeCol := 0; + for i := 1 to NoVariables do + begin + varname := OS3MainFrm.DataGrid.Cells[i,0]; + if (varname = BubbleEdit.Text) then BubbleCol := i; + if (varname = XEdit.Text) then XCol := i; + if (varname = YEdit.Text) then YCol := i; + if (varname = SizeEdit.Text) then SizeCol := i; + end; + if ((BubbleCol = 0) or (XCol = 0) or (YCol = 0) or (SizeCol = 0)) then + begin + MessageDlg('One or more variables not found.', mtError, [mbOK], 0); + ModalResult := mrNone; + Exit; + end; + + // get number of bubbles and replications per bubble (number of bubble id's) + minrep := 1000; + maxrep := -1; + for i := 1 to NoCases do + begin + intcell := StrToInt(OS3MainFrm.DataGrid.Cells[BubbleCol,i]); + if (intcell > maxrep) then maxrep := intcell; + if (intcell < minrep) then minrep := intcell; + end; + nobubbles := maxrep - minrep + 1; + noreplications := 1; + intcell := StrToInt(OS3MainFrm.DataGrid.Cells[BubbleCol,1]); + for i := 2 to NoCases do + begin + cell := StrToInt(OS3MainFrm.DataGrid.Cells[BubbleCol,i]); + if (cell = intcell) then noreplications := noreplications + 1; + end; + + // get min, max and range of Y + Ymin := 1.0e308; + Ymax := -1.0e308; + for i := 1 to NoCases do + begin + cellvalue := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,i]); + if (cellvalue > Ymax) then Ymax := cellvalue; + if (cellvalue < Ymin) then Ymin := cellvalue; + end; + Yrange := Ymax - Ymin; + Ystep := Yrange / 10; + + // get min, max and range of X + Xmin := 10000; + Xmax := -1; + for i := 1 to NoCases do + begin + intcell := StrToInt(OS3MainFrm.DataGrid.Cells[XCol,i]); + if (intcell > Xmax) then Xmax := intcell; + if (intcell < Xmin) then Xmin := intcell; + end; + Xrange := Xmax - Xmin; + Xstep := Xrange div (noreplications-1); + + // get min, max, range, and increment of bubble sizes + BubMin := 1.0e308; + BubMax := -1.0e308; + for i := 1 to NoCases do + begin + cellvalue := StrToFloat(OS3MainFrm.DataGrid.Cells[SizeCol,i]); + if (cellvalue > BubMax) then BubMax := cellvalue; + if (cellvalue < BubMin) then BubMin := cellvalue; + end; + BubRange := BubMax - BubMin; + + // Display basic statistics + ncases := NoCases div noreplications; + GrandYMean := 0.0; + GrandSizeMean := 0.0; + SetLength(CaseYMeans,ncases); + SetLength(CaseSizeMeans,ncases); + SetLength(Ymeans,noreplications); + SetLength(SizeMeans,noreplications); + for i := 0 to ncases - 1 do + begin + CaseYMeans[i] := 0.0; + CaseSizeMeans[i] := 0.0; + end; + for i := 0 to noreplications - 1 do + begin + Ymeans[i] := 0.0; + SizeMeans[i] := 0.0; + end; + + i := 1; + while (i <= NoCases) do + begin + for j := 1 to noreplications do + begin + bubbleID := StrToInt(OS3MainFrm.DataGrid.Cells[BubbleCol,i]); + yvalue := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,i]); + sizevalue := StrToFloat(OS3MainFrm.DataGrid.Cells[SizeCol,i]); + GrandYMean := GrandYMean + yvalue; + GrandSizeMean := GrandSizeMean + sizevalue; + Ymeans[j-1] := Ymeans[j-1] + yvalue; + SizeMeans[j-1] := SizeMeans[j-1] + sizevalue; + CaseYMeans[bubbleID-1] := CaseYMeans[bubbleID-1] + yvalue; + CaseSizeMeans[bubbleID-1] := CaseSizeMeans[bubbleID-1] + sizevalue; + inc(i); + end; + end; + + GrandYMean := GrandYMean / (ncases * noreplications); + GrandSizeMean := GrandSizeMean / (ncases * noreplications); + for j := 0 to noreplications - 1 do + begin + Ymeans[j] := Ymeans[j] / ncases; + SizeMeans[j] := SizeMeans[j] / ncases; + end; + for i := 0 to ncases - 1 do + begin + CaseYMeans[i] := CaseYMeans[i] / noreplications; + CaseSizeMeans[i] := CaseSizeMeans[i] / noreplications; + end; + + lReport := TStringList.Create; + try + lReport.Add('MEANS FOR Y AND SIZE VARIABLES'); + lReport.Add(''); + lReport.Add('Grand Mean for Y := %8.3f', [GrandYMean]); + lReport.Add('Grand Mean for Size := %8.3f', [GrandSizeMean]); + lReport.Add(''); + lReport.Add('REPLICATION MEAN Y VALUES (ACROSS OBJECTS)'); + for j := 0 to noreplications - 1 do + lReport.Add('Replication %5d Mean := %8.3f', [j+1, Ymeans[j]]); + lReport.Add(''); + lReport.Add('REPLICATION MEAN SIZE VALUES (ACROSS OBJECTS)'); + for j := 0 to noreplications - 1 do + lReport.Add('Replication %5d Mean := %8.3f', [j+1, SizeMeans[j]]); + lReport.Add(''); + lReport.Add('MEAN Y VALUES FOR EACH BUBBLE (OBJECT)'); + for i := 0 to ncases - 1 do + lReport.Add('Object %5d Mean := %8.3f', [i+1, CaseYMeans[i]]); + lReport.Add(''); + lReport.Add('MEAN SIZE VALUES FOR EACH BUBBLE (OBJECT)'); + for i := 0 to ncases - 1 do + lReport.Add('Object %5d Mean := %8.3f', [i+1, CaseSizeMeans[i]]); + + DisplayReport(lReport); + + finally + lReport.Free; + SizeMeans := nil; + Ymeans := nil; + CaseSizeMeans := nil; + CaseYMeans := nil; + end; + +//-------------------------------------------------------------------------- +// Plotting Section +//--------------------------------------------------------------------------- + //BlankFrm.Image1.Canvas.Clear; + BlankFrm.Show; + BlankFrm.Caption := 'BUBBLE PLOT of ' + OS3MainFrm.FileNameEdit.Text; + Xlabel := XlabelEdit.Text; + Ylabel := YlabelEdit.Text; + Title := TitleEdit.Text; + ImageHi := BlankFrm.Image1.Height; + ImageWide := BlankFrm.Image1.Width; + Xstart := ImageWide div 10; + Xend := (ImageWide * 9) div 10; + Ystart := ImageHi div 10; + Yend := (ImageHi * 8) div 10; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Rectangle(0,0,ImageWide,ImageHi); + BlankFrm.Image1.Canvas.FloodFill(0,0,clWhite,fsBorder); + BlankFrm.Image1.Canvas.TextOut(Xstart-10,Ystart-30,Ylabel); + LabelWide := BlankFrm.Image1.Canvas.TextWidth(Xlabel); + BlankFrm.Image1.Canvas.TextOut((Xend-Xstart) div 2 - LabelWide,Yend + 40,Xlabel); + LabelWide := BlankFrm.Image1.Canvas.TextWidth(Title); + BlankFrm.Image1.Canvas.TextOut((Xend-Xstart) div 2 - LabelWide div 2, Ystart - 40,Title); + + // draw axis lines + BlankFrm.Image1.Canvas.MoveTo(Xstart,Yend); + BlankFrm.Image1.Canvas.LineTo(Xend,Yend); + BlankFrm.Image1.Canvas.MoveTo(Xstart,Yend); + BlankFrm.Image1.Canvas.LineTo(Xstart,Ystart); + + // create y axis values + Yincr := (Yend - Ystart) div 10; + for i := 0 to 10 do // print Y axis values + begin + place := Yend - (i * Yincr); + value := Ymin + (Ystep * i); + valstr := format('%.2f',[value]); + astring := valstr; + TextHi := BlankFrm.Image1.Canvas.TextHeight(astring); + BlankFrm.Image1.Canvas.TextOut(Xstart-30,place-TextHi,astring); + end; + + // create x axis values + for i := 1 to noreplications do // print x axis + begin + value := Xmin + ((i-1) * Xstep); + ratio := i / noreplications; + Xpos := round(ratio * (Xend - Xstart)); + valstr := format('%.0f',[value]); + astring := valstr; + BlankFrm.Image1.Canvas.TextOut(Xpos,Yend + 20,astring); + end; + + // Plot the bubbles + for i := 1 to NoCases do + begin + intcell := StrToInt(OS3MainFrm.DataGrid.Cells[BubbleCol,i]); + xvalue := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,i]); + cellvalue := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,i]); + yprop := Yend - round(((cellvalue-Ymin) / Yrange) * (Yend - Ystart)); + cellvalue := StrToFloat(OS3MainFrm.DataGrid.Cells[SizeCol,i]); + astring := Trim(OS3MainFrm.DataGrid.Cells[BubbleCol,i]); + cellvalue := ((cellvalue - BubMin) / BubRange) * 20; + cellvalue := cellvalue + 10; + ratio := ((xvalue - Xmin) / Xstep) + 1; + ratio := (ratio / noreplications) * (Xend - Xstart); + Xpos := ceil(ratio); + BubColor := intcell - 1; + while (Bubcolor > 11) do Bubcolor := 12 - Bubcolor; + BlankFrm.Image1.Canvas.Brush.Color := DATA_COLORS[Bubcolor]; + X1 := Xpos - ceil(cellvalue); + Y1 := yprop - ceil(cellvalue); + X2 := Xpos + ceil(cellvalue); + Y2 := yprop + ceil(cellvalue); + BlankFrm.Image1.Canvas.Ellipse(X1,Y1,X2,Y2); + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + dx := BlankFrm.Image1.Canvas.TextWidth(astring) div 2; + dy := BlankFrm.Image1.Canvas.TextHeight(astring) div 2; + BlankFrm.Image1.Canvas.TextOut(Xpos-dx, yprop-dy, astring); + end; + + // Transform data matrix if elected + if (TransformChk.Checked = true) then + begin + ncases := nobubbles; + ncols := noreplications * 3 + 1; + + // Note - columns: 1:=object ID, 2 to noreplications := X, + // next noreplications := Y, next noreplications := size + SetLength(Data,ncases,ncols); + i := 1; + while (i <= NoCases) do + begin + for j := 1 to noreplications do + begin + bubbleID := StrToInt(OS3MainFrm.DataGrid.Cells[BubbleCol,i]); + xvalue := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,i]); + yvalue := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,i]); + sizevalue := StrToFloat(OS3MainFrm.DataGrid.Cells[SizeCol,i]); + Data[bubbleID-1,0] := bubbleID; + Data[bubbleID-1,j] := xvalue; + Data[bubbleID-1,noreplications+j] := yvalue; + Data[bubbleID-1,noreplications*2+j] := sizevalue; + inc(i); + end; + end; + + SetLength(labels,NoVariables+1); + for i := 1 to NoVariables do labels[i] := OS3MainFrm.DataGrid.Cells[i,0]; + ClearGrid; + OS3MainFrm.DataGrid.RowCount := ncases + 1; + OS3MainFrm.DataGrid.ColCount := ncols + 1; + + for i := 1 to ncases do + begin + OS3MainFrm.DataGrid.Cells[0,i] := IntToStr(i); + for j := 1 to ncols do + OS3MainFrm.DataGrid.Cells[j,i] := FloatToStr(Data[i-1,j-1]); + end; + OS3MainFrm.DataGrid.Cells[1,0] := labels[1]; + + for j := 2 to NoVariables do // clear dictionary + begin + for i := 0 to 7 do DictionaryFrm.DictGrid.Cells[i,j] := ''; + DictionaryFrm.DictGrid.RowCount := DictionaryFrm.DictGrid.RowCount - 1; + VarDefined[j] := false; + end; + DictionaryFrm.DictGrid.Cells[1,1] := labels[1]; + + for j := 1 to noreplications do + begin + outline := labels[2] + IntToStr(j); + newcol := j + 1; + if (newcol+1 > DictionaryFrm.DictGrid.RowCount) then + DictionaryFrm.DictGrid.RowCount := DictionaryFrm.DictGrid.RowCount + 1; + DictionaryFrm.Defaults(Self,newcol); + VarDefined[newcol] := true; + DictionaryFrm.DictGrid.Cells[1,newcol] := outline; + OS3MainFrm.DataGrid.Cells[newcol,0] := outline; + end; + + for j := 1 to noreplications do + begin + outline := labels[3] + IntToStr(j); + newcol := j + 1 + noreplications; + OS3MainFrm.DataGrid.Cells[newcol,0] := outline; + if (newcol+1 > DictionaryFrm.DictGrid.RowCount) then + DictionaryFrm.DictGrid.RowCount := DictionaryFrm.DictGrid.RowCount + 1; + DictionaryFrm.Defaults(Self,newcol); + VarDefined[newcol] := true; + DictionaryFrm.DictGrid.Cells[1,newcol] := outline; + end; + + for j := 1 to noreplications do + begin + outline := labels[4] + IntToStr(j); + newcol := j + 1 + noreplications * 2; + OS3MainFrm.DataGrid.Cells[newcol,0] := outline; + + if (newcol+1 > DictionaryFrm.DictGrid.RowCount) then + DictionaryFrm.DictGrid.RowCount := DictionaryFrm.DictGrid.RowCount + 1; + DictionaryFrm.Defaults(Self,newcol); + VarDefined[newcol] := true; + + DictionaryFrm.DictGrid.Cells[1,newcol] := outline; + end; + + NoVariables := ncols; + NoCases := ncases; + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + Data := nil; + labels := nil; + end; +end; + +procedure TBubbleForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Panel1.Constraints.MinHeight := SizeOutBtn.Top + SizeOutBtn.Height; + Panel1.Constraints.MinWidth := 2*Label2.Width + IDInBtn.Width + 2*VarList.BorderSpacing.Right; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := True; +end; + +procedure TBubbleForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm); + if BlankFrm = nil then Application.CreateForm(TBlankFrm, BlankFrm); +end; + +procedure TBubbleForm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TBubbleForm.IDOutBtnClick(Sender: TObject); +begin + if BubbleEdit.Text <> '' then + VarList.Items.Add(BubbleEdit.Text); + UpdateBtnStates; +end; + +procedure TBubbleForm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + BubbleEdit.Text := ''; + XEdit.Text := ''; + YEdit.Text := ''; + SizeEdit.Text := ''; + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TBubbleForm.SizeInBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while (SizeEdit.Text = '') and (i < VarList.Items.Count) do + begin + if VarList.Selected[i] then + begin + SizeEdit.Text := VarList.Items[i]; + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TBubbleForm.SizeOutBtnClick(Sender: TObject); +begin + if SizeEdit.Text <> '' then + VarList.Items.Add(SizeEdit.Text); + UpdateBtnStates; +end; + +procedure TBubbleForm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TBubbleForm.XInBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while (XEdit.Text = '') and (i < VarList.Items.Count) do + begin + if VarList.Selected[i] then + begin + XEdit.Text := VarList.Items[i]; + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TBubbleForm.XOutBtnClick(Sender: TObject); +begin + if XEdit.Text <> '' then + VarList.Items.Add(XEdit.Text); + UpdateBtnStates; +end; + +procedure TBubbleForm.YInBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while (YEdit.Text = '') and (i < VarList.Items.Count) do + begin + if VarList.Selected[i] then + begin + YEdit.Text := VarList.Items[i]; + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TBubbleForm.YOutBtnClick(Sender: TObject); +begin + if YEdit.Text <> '' then + VarList.Items.Add(YEdit.Text); + UpdateBtnStates; +end; + +procedure TBubbleForm.UpdateBtnStates; +var + i: Integer; + lSelected: Boolean; +begin + lSelected := false; + for i:=0 to VarList.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + + IDInBtn.Enabled := lSelected and (BubbleEdit.Text = ''); + XInBtn.Enabled := lSelected and (XEdit.Text = ''); + YInBtn.Enabled := lSelected and (YEdit.Text = ''); + SizeInBtn.Enabled := lSelected and (SizeEdit.Text = ''); + IDOutBtn.Enabled := BubbleEdit.Text <> ''; + XOutBtn.Enabled := XEdit.Text <> ''; + YOutBtn.Enabled := YEdit.Text <> ''; + SizeOutBtn.Enabled := SizeEdit.Text <> ''; +end; + + +initialization + {$I bubbleplotunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/comparedistunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/comparedistunit.lfm new file mode 100644 index 000000000..6093a06ab --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/comparedistunit.lfm @@ -0,0 +1,398 @@ +object CompareDistFrm: TCompareDistFrm + Left = 462 + Height = 375 + Top = 227 + Width = 516 + AutoSize = True + Caption = 'Compare Cumulative Distributions' + ClientHeight = 375 + ClientWidth = 516 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CompareGroup: TRadioGroup + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 326 + Height = 72 + Top = 8 + Width = 182 + Anchors = [akTop, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Compare To:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 178 + ItemIndex = 0 + Items.Strings = ( + 'A Theoretical Distribution' + 'Another Variable' + ) + OnClick = CompareGroupClick + TabOrder = 2 + end + object DistGroup: TRadioGroup + AnchorSideLeft.Control = CompareGroup + AnchorSideTop.Control = CompareGroup + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 326 + Height = 135 + Top = 96 + Width = 182 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + Caption = 'Theoretical Distributions:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 115 + ClientWidth = 178 + Items.Strings = ( + 'Normal Distribution' + 't-Distribution' + 'Chi Square Distribution' + 'F Distribution' + 'Poisson Distribution' + ) + OnClick = DistGroupClick + TabOrder = 3 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 299 + Height = 25 + Top = 342 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 365 + Height = 25 + Top = 342 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 453 + Height = 25 + Top = 342 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 7 + end + object PlotTypeGrp: TGroupBox + AnchorSideLeft.Control = CompareGroup + AnchorSideTop.Control = DistGroup + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 326 + Height = 74 + Top = 247 + Width = 182 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Plot Type:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 54 + ClientWidth = 178 + TabOrder = 4 + object PointsChk: TRadioButton + Left = 12 + Height = 19 + Top = 6 + Width = 67 + BorderSpacing.Left = 12 + Caption = '3DPoints' + Checked = True + TabOrder = 0 + TabStop = True + end + object LinesChk: TRadioButton + Left = 12 + Height = 19 + Top = 27 + Width = 67 + BorderSpacing.Left = 12 + BorderSpacing.Bottom = 8 + Caption = '3DLines' + TabOrder = 1 + end + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 47 + Top = 279 + Width = 298 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Option:' + ClientHeight = 27 + ClientWidth = 294 + TabOrder = 1 + object BothChk: TCheckBox + Left = 12 + Height = 19 + Top = 0 + Width = 270 + BorderSpacing.Left = 12 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Plot both Frequency and cumulative Frequency' + TabOrder = 0 + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ResetBtn + Left = 0 + Height = 8 + Top = 326 + Width = 516 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = CompareGroup + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 263 + Top = 8 + Width = 310 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 263 + ClientWidth = 310 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 49 + Caption = 'Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = VerticalCenterBevel + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 246 + Top = 17 + Width = 150 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object Var1InBtn: TBitBtn + AnchorSideLeft.Control = VerticalCenterBevel + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Var1OutBtn + Left = 160 + Height = 28 + Top = 53 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Var1InBtnClick + Spacing = 0 + TabOrder = 1 + end + object Var1OutBtn: TBitBtn + AnchorSideLeft.Control = Var1InBtn + AnchorSideBottom.Control = VerticalCenterBevel + Left = 160 + Height = 28 + Top = 85 + Width = 28 + Anchors = [akLeft, akBottom] + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Var1OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object Var2InBtn: TBitBtn + AnchorSideLeft.Control = VerticalCenterBevel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VerticalCenterBevel + AnchorSideTop.Side = asrBottom + Left = 160 + Height = 28 + Top = 168 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Var2InBtnClick + Spacing = 0 + TabOrder = 3 + end + object Var2OutBtn: TBitBtn + AnchorSideLeft.Control = Var2InBtn + AnchorSideTop.Control = Var2InBtn + AnchorSideTop.Side = asrBottom + Left = 160 + Height = 28 + Top = 200 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Var2OutBtnClick + Spacing = 0 + TabOrder = 4 + end + object Label2: TLabel + AnchorSideLeft.Control = VarOneEdit + AnchorSideBottom.Control = VarOneEdit + Left = 196 + Height = 15 + Top = 61 + Width = 66 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Variable One' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = VarTwoEdit + AnchorSideBottom.Control = VarTwoEdit + Left = 196 + Height = 15 + Top = 176 + Width = 65 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Variable Two' + ParentColor = False + end + object VarOneEdit: TEdit + AnchorSideLeft.Control = Var1InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Var1OutBtn + AnchorSideBottom.Side = asrBottom + Left = 196 + Height = 23 + Top = 78 + Width = 114 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 5 + Text = 'VarOneEdit' + end + object VarTwoEdit: TEdit + AnchorSideLeft.Control = Var2InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Var2OutBtn + AnchorSideBottom.Side = asrBottom + Left = 196 + Height = 23 + Top = 193 + Width = 114 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'Edit1' + end + object VerticalCenterBevel: TBevel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrCenter + Left = 150 + Height = 55 + Top = 113 + Width = 10 + Shape = bsSpacer + end + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/comparedistunit.pas b/applications/lazstats/source/forms/analysis/descriptive/comparedistunit.pas new file mode 100644 index 000000000..6f73c66e9 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/comparedistunit.pas @@ -0,0 +1,594 @@ +// Use file "cansas.laz" for testing + +unit CompareDistUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + OutputUnit, FunctionsLib, Globals, GraphLib, DataProcs, MainUnit; + +type + + { TCompareDistFrm } + + TCompareDistFrm = class(TForm) + Bevel1: TBevel; + LinesChk: TRadioButton; + PointsChk: TRadioButton; + VerticalCenterBevel: TBevel; + BothChk: TCheckBox; + GroupBox1: TGroupBox; + Panel1: TPanel; + PlotTypeGrp: TGroupBox; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + CompareGroup: TRadioGroup; + DistGroup: TRadioGroup; + VarOneEdit: TEdit; + VarTwoEdit: TEdit; + Label2: TLabel; + Label3: TLabel; + Var1InBtn: TBitBtn; + Var1OutBtn: TBitBtn; + Var2InBtn: TBitBtn; + Var2OutBtn: TBitBtn; + Label1: TLabel; + VarList: TListBox; + procedure CompareGroupClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure DistGroupClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure Var1InBtnClick(Sender: TObject); + procedure Var1OutBtnClick(Sender: TObject); + procedure Var2InBtnClick(Sender: TObject); + procedure Var2OutBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + compareto: integer; + disttype: integer; + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + CompareDistFrm: TCompareDistFrm; + +implementation + +uses + Math; + +{ TCompareDistFrm } + +procedure TCompareDistFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Panel1.Constraints.MinWidth := Groupbox1.Width; + Panel1.Constraints.MinHeight := PlotTypeGrp.Top + PlotTypeGrp.Height - GroupBox1.Height - Panel1.BorderSpacing.Bottom - Panel1.Top; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TCompareDistFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if GraphFrm = nil then Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TCompareDistFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(nil); +end; + +procedure TCompareDistFrm.CompareGroupClick(Sender: TObject); +begin + compareTo := CompareGroup.ItemIndex; + Label3.Enabled := (compareTo = 1); + VarTwoEdit.Enabled := (compareTo = 1); + Var2InBtn.Enabled := (compareTo = 1); + Var2OutBtn.Enabled := (compareTo = 1); +end; + +procedure TCompareDistFrm.ComputeBtnClick(Sender: TObject); +var + Var1Freq : IntDyneVec; + Var2Freq : IntDyneVec; + XValue1 : DblDyneVec; + XValue2 : DblDyneVec; + Cumfreq1 : DblDyneVec; + Cumfreq2 : DblDyneVec; + i, j, k, col1, col2, Ncases, noints : integer; + min1, max1, min2, max2, range1, range2, value : double; + incrsize1, incrsize2, prob1,prob2, KS, mean, DegFree : double; + cellval, name1, name2 : string; + df1, df2 : integer; + xtitle : string; + msg: String; + lReport: TStrings; +begin + SetLength(Var1Freq, NoCases + 1); + SetLength(Var2Freq, NoCases + 1); + SetLength(XValue1, NoCases + 1); + SetLength(XValue2, NoCases + 1); + SetLength(Cumfreq1, NoCases + 1); + SetLength(Cumfreq2, NoCases + 1); + + // Get columns of the variables + col1 := 0; + col2 := 0; + for i := 1 to NoVariables do + begin + if VarOneEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then col1 := i; + if compareto = 1 then + begin + if VarTwoEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then col2 := i; + end; + end; + + msg := ''; + case CompareTo of + 0: if col1 = 0 then + msg := 'Variable not specified.'; + 1: if col1 = 0 then + msg := 'Variable One is not specified.' + else if col2 = 0 then + msg := 'Variable Two is not specified.'; + end; + if msg <> '' then + begin + MessageDlg(msg, mtError, [mbOK], 0); + exit; + end; + + // get min and max values for variable in col1 + min1 := 1.0e308; + max1 := -1.0e308; + Ncases := 0; + for j := 1 to NoCases do + begin + if not ValidValue(j,col1) then continue; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[col1,j]); + if value > max1 then max1 := value; + if value < min1 then min1 := value; + inc(Ncases); + end; + + noints := NoCases - 1; // number of intervals + if noints > 20 then noints := 20; + range1 := max1 - min1 + 1.0; + incrsize1 := range1 / noints; + name1 := VarOneEdit.Text; + + if compareTo = 1 then + begin + min2 := 1.0e32; + max2 := -1.0e32; + for j := 1 to NoCases do + begin + if Not ValidValue(j,col2) then continue; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[col2,j]); + if value > max2 then max2 := value; + if value < min2 then min2 := value; + end; + range2 := max2 - min2 + 1.0; + incrsize2 := range2 / noints; + name2 := VarTwoEdit.Text; + end; + + //Now, get frequency of cases in each interval + for j := 1 to noints+1 do + Var1Freq[j-1] := 0; + for j := 1 to NoCases do + begin + if Not ValidValue(j,col1) then continue; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[col1,j]); + for k := 1 to noints do + begin + if (value >= min1 + ((k-1) * incrsize1)) and + (value < min1 + (k * incrsize1)) + then + Var1Freq[k-1] := Var1Freq[k-1] + 1; + end; + end; + Cumfreq1[0] := Var1Freq[0]; + for j := 1 to noints+1 do + XValue1[j-1] := min1 + (j-1) * incrsize1; + for j := 1 to noints do + Cumfreq1[j] := Cumfreq1[j-1] + Var1Freq[j]; + if compareTo = 1 then // do same for second variable + begin + for j := 1 to noints+1 do + Var2Freq[j-1] := 0; + for j := 1 to NoCases do + begin + if Not ValidValue(j,col2) then continue; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[col2,j]); + for k := 1 to noints do + begin + if (value >= min2 + ((k-1) * incrsize2)) and + (value < min2 + (k * incrsize2)) + then + Var2Freq[k-1] := Var2Freq[k-1] + 1; + end; + end; + Cumfreq2[0] := Var2Freq[0]; + for j := 1 to noints+1 do + XValue2[j-1] := min2 + (j-1) * incrsize2; + for j := 1 to noints do + Cumfreq2[j] := Cumfreq2[j-1] + Var2Freq[j]; + end; + + // Get theoretical distribution frequencies for selected dist. + if compareTo = 0 then + begin + if DistGroup.ItemIndex = 0 then // normal curve + begin + name2 := 'Normal'; + min2 := -3.0; + max2 := 3.0; + range2 := max2 - min2; + incrsize2 := range2 / noints; + Xvalue2[0] := min2; + Xvalue2[noints] := max2; + for i := 1 to noints do + begin + Xvalue2[i-1] := min2 + (i-1) * incrsize2; + Xvalue2[i] := min2 + (i) * incrsize2; + prob1 := probz(abs(Xvalue2[i-1])); + prob2 := probz(abs(Xvalue2[i])); + if prob1 > prob2 then + Var2Freq[i-1] := round((prob1-prob2) * Ncases) + else + Var2Freq[i-1] := round((prob2-prob1) * Ncases) + end; + Cumfreq2[0] := Var2Freq[0]; + for i := 1 to noints do + Cumfreq2[i] := Cumfreq2[i-1] + Var2Freq[i]; + end + else + if DistGroup.ItemIndex = 1 then // t-distribution + begin + name2 := 't-Dist.'; + min2 := -3.0; + max2 := 3.0; + df1 := Ncases - 1; + range2 := max2 - min2; + incrsize2 := range2 / noints; + Xvalue2[0] := min2; + Xvalue2[noints] := max2; + for i := 1 to noints do + begin + Xvalue2[i-1] := min2 + (i-1) * incrsize2; + Xvalue2[i] := min2 + (i) * incrsize2; + prob1 := 0.5 * probt(Xvalue2[i-1],df1); + prob2 := 0.5 * probt(Xvalue2[i],df1); + if prob1 > prob2 then + Var2Freq[i-1] := round((prob1-prob2) * Ncases) + else + Var2Freq[i-1] := round((prob2-prob1) * Ncases) + end; + Cumfreq2[0] := Var2Freq[0]; + for i := 1 to noints do + Cumfreq2[i] := Cumfreq2[i-1] + Var2Freq[i]; + end + else + if DistGroup.ItemIndex = 2 then // chi squared distribution + begin + cellval := InputBox('Deg. Freedom 1 Entry','DF 1',''); + df1 := StrToInt(cellval); + name2 := 'Chi Sqrd'; + min2 := 0.0; + max2 := 20.0; + range2 := max2 - min2; + incrsize2 := range2 / noints; + Xvalue2[0] := min2; + Xvalue2[noints] := max2; + for i := 1 to noints do + begin + Xvalue2[i-1] := min2 + (i-1) * incrsize2; + Xvalue2[i] := min2 + (i) * incrsize2; + prob1 := chisquaredprob(Xvalue2[i-1],df1); + prob2 := chisquaredprob(Xvalue2[i],df1); + if prob1 > prob2 then + Var2Freq[i-1] := round((prob1-prob2) * Ncases) + else + Var2Freq[i-1] := round((prob2-prob1) * Ncases) + end; + Cumfreq2[0] := Var2Freq[0]; + for i := 1 to noints do + Cumfreq2[i] := Cumfreq2[i-1] + Var2Freq[i]; + end + else + if DistGroup.ItemIndex = 3 then // F distribution + begin + // get degrees of freedom + cellval := InputBox('Deg. Freedom 1 Entry','DF 1',''); + df1 := StrToInt(cellval); + cellval := InputBox('Deg. Freedom 2 Entry','DF 2',''); + df2 := StrToInt(cellval); + name2 := 'F Dist.'; + min2 := 0.0; + max2 := 3.0; + range2 := max2 - min2; + incrsize2 := range2 / noints; + Xvalue2[0] := min2; + Xvalue2[noints] := max2; + for i := 1 to noints do + begin + Xvalue2[i-1] := min2 + (i-1) * incrsize2; + Xvalue2[i] := min2 + (i) * incrsize2; + prob1 := probf(Xvalue2[i-1],df1,df2); + prob2 := probf(Xvalue2[i],df1,df2); + if prob1 > prob2 then + Var2Freq[i-1] := round((prob1-prob2) * Ncases) + else + Var2Freq[i-1] := round((prob2-prob1) * Ncases) + end; + Cumfreq2[0] := Var2Freq[0]; + for i := 1 to noints do + Cumfreq2[i] := Cumfreq2[i-1] + Var2Freq[i]; + end + else + if DistGroup.ItemIndex = 4 then // Poisson distribution + begin + name2 := 'Poisson'; + mean := 0; // use as parameter a in pdf call + min2 := min1; + max2 := max1; + if max2 > 13 then + begin + MessageDlg('Value > 13 found. Factorial too large - exiting.', mtError, [mbOK], 0); + exit; + end; + for i := 1 to Ncases do + mean := mean + StrToFloat(OS3MainFrm.DataGrid.Cells[col1,i]); + mean := mean / Ncases; + cellval := IntToStr(round(mean)); + cellval := InputBox('Parameter Entry (mean)','DF 1',cellval); + degfree := StrToFloat(cellval); + range2 := max2 - min2; + incrsize2 := range2 / noints; +// Xvalue2[0] := min2; + Xvalue2[noints] := max2; + for i := 1 to noints do + begin + Xvalue2[i-1] := min2 + (i-1) * incrsize2; + Xvalue2[i] := min2 + (i) * incrsize2; + poisson_pdf ( round(Xvalue2[i-1]), degfree, prob1 ); +// prob1 := (Xvalue2[i-1],df1); +// prob2 := chisquaredprob(Xvalue2[i],df1); +// if prob1 > prob2 then + Var2Freq[i-1] := round((prob1) * Ncases); +// else Var2Freq[i-1] := round((prob2-prob1) * Ncases) + end; + Cumfreq2[0] := Var2Freq[0]; + for i := 1 to noints do + Cumfreq2[i] := Cumfreq2[i-1] + Var2Freq[i]; + end; + end; + + lReport := TStringList.Create; + try + lReport.Add('DISTRIBUTION COMPARISON by Bill Miller'); + lReport.Add(''); + lReport.Add('%10s %10s %10s %10s %10s %10s', [ + name1, name1, name1, name2, name2, name2 + ]); + lReport.Add('%10s %10s %10s %10s %10s %10s', [ + 'X1 Value','Frequency','Cum. Freq.','X2 Value','Frequency','Cum. Freq.' + ]); + for i := 1 to noints do + lReport.Add('%10.3f %10d %10.3f %10.3f %10d %10.3f', [ + XValue1[i-1],Var1Freq[i-1],Cumfreq1[i-1],XValue2[i-1],Var2Freq[i-1],Cumfreq2[i-1] + ]); + cellval := 'D'; + KS := KolmogorovTest(noints, Cumfreq1,noints, Cumfreq2, cellval); + // lReport.Add('Kolmogorov-Smirnov statistic := %5.3f', [KS]); + + DisplayReport(lReport); + finally + lReport.Free; + end; + + // plot the cdfs + xtitle := 'Red = ' + VarOneEdit.Text + ' Blue = ' + name2; + cellval := 'Plot of Cumulative Distributions'; + if LinesChk.Checked then + GraphFrm.barwideprop := 1.0 + else + GraphFrm.barwideprop := 0.5; + + GraphFrm.nosets := 2; + GraphFrm.nbars := noints+1; + GraphFrm.Heading := cellval; + GraphFrm.XTitle := xtitle; + GraphFrm.YTitle := 'Frequency'; + SetLength(GraphFrm.Ypoints,2,noints+1); + SetLength(GraphFrm.Xpoints,1,noints+1); + for k := 1 to noints+1 do + begin + GraphFrm.Ypoints[0,k-1] := Cumfreq1[k-1]; + GraphFrm.Ypoints[1,k-1] := CumFreq2[k-1]; + GraphFrm.Xpoints[0,k-1] := k; + end; + GraphFrm.AutoScaled := true; + if LinesChk.Checked then + GraphFrm.GraphType := 6 // 3d lines + else + GraphFrm.GraphType := 8; // 3D points + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlue; + GraphFrm.FloorColor := clGray; + GraphFrm.ShowLeftWall := true; + GraphFrm.ShowRightWall := true; + GraphFrm.ShowBottomWall := true; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + + if BothChk.Checked then // plot the frequencies + begin + xtitle := 'Red = ' + VarOneEdit.Text + ' Blue = ' + name2; + cellval := 'Plot of Cumulative Distributions'; + if LinesChk.Checked then + GraphFrm.BarWideProp := 1.0 + else + GraphFrm.BarWideProp := 0.5; + GraphFrm.nosets := 2; + GraphFrm.nbars := noints+1; + GraphFrm.Heading := cellval; + GraphFrm.XTitle := xtitle; + GraphFrm.YTitle := 'Frequency'; + SetLength(GraphFrm.Ypoints,2,noints+1); + SetLength(GraphFrm.Xpoints,1,noints+1); + for k := 1 to noints+1 do + begin + GraphFrm.Ypoints[0,k-1] := Var1Freq[k-1]; + GraphFrm.Ypoints[1,k-1] := Var2Freq[k-1]; + GraphFrm.Xpoints[0,k-1] := k; + end; + GraphFrm.AutoScaled := true; + if LinesChk.Checked then + GraphFrm.GraphType := 6 // 3d lines + else + GraphFrm.GraphType := 8; // 3D points + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlue; + GraphFrm.FloorColor := clGray; + GraphFrm.ShowLeftWall := true; + GraphFrm.ShowRightWall := true; + GraphFrm.ShowBottomWall := true; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + end; + + // clean up + Cumfreq2 := nil; + Cumfreq1 := nil; + XValue1 := nil; + XValue2 := nil; + Var2Freq := nil; + Var1Freq := nil; +end; + +procedure TCompareDistFrm.DistGroupClick(Sender: TObject); +begin + disttype := DistGroup.ItemIndex; +end; + +procedure TCompareDistFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + VarOneEdit.Text := ''; + VarTwoEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + Label3.Enabled := false; + CompareGroup.ItemIndex := 0; + DistGroup.ItemIndex := 0; + LinesChk.Checked := false; + PointsChk.Checked := true; +end; + +procedure TCompareDistFrm.Var1InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while (VarOneEdit.Text = '') and (i < VarList.Items.Count) do + begin + if VarList.Selected[i] then + begin + VarOneEdit.Text := VarList.Items[i]; + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TCompareDistFrm.Var1OutBtnClick(Sender: TObject); +begin + if VarOneEdit.Text <> '' then + begin + VarList.Items.Add(VarOneEdit.Text); + VarOneEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TCompareDistFrm.Var2InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while (VarTwoEdit.Text = '') and (i < VarList.Items.Count) do + begin + if VarList.Selected[i] then + begin + VarTwoEdit.Text := VarList.Items[i]; + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TCompareDistFrm.Var2OutBtnClick(Sender: TObject); +begin + if VarTwoEdit.Text <> '' then + begin + VarList.Items.Add(VarTwoEdit.Text); + VarTwoEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TCompareDistFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TCompareDistFrm.UpdateBtnStates; +begin + Var1InBtn.Enabled := (VarList.ItemIndex > -1) and (VarOneEdit.Text = ''); + Var2InBtn.Enabled := (VarList.ItemIndex > -1) and (VarTwoEdit.Text = ''); + Var1OutBtn.Enabled := VarOneEdit.Text <> ''; + Var2OutBtn.Enabled := VarTwoEdit.Text <> ''; +end; + +initialization + {$I comparedistunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/crosstabunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/crosstabunit.lfm new file mode 100644 index 000000000..995f496c2 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/crosstabunit.lfm @@ -0,0 +1,218 @@ +object CrossTabFrm: TCrossTabFrm + Left = 459 + Height = 347 + Top = 230 + Width = 421 + AutoSize = True + Caption = 'Cross Tabulation' + ClientHeight = 347 + ClientWidth = 421 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Panel2: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 290 + Top = 8 + Width = 405 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 290 + ClientWidth = 405 + Constraints.MinHeight = 200 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Panel2 + Left = 0 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = SelList + AnchorSideTop.Control = Panel2 + Left = 224 + Height = 15 + Top = 0 + Width = 104 + Caption = 'Variables to Analyze' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 273 + Top = 17 + Width = 180 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object SelList: TListBox + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 224 + Height = 273 + Top = 17 + Width = 181 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 3 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = VertCenterBevel + Left = 188 + Height = 28 + Top = 119 + Width = 28 + Anchors = [akLeft, akBottom] + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VertCenterBevel + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = VertCenterBevel + AnchorSideBottom.Side = asrBottom + Left = 188 + Height = 28 + Top = 159 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object VertCenterBevel: TBevel + AnchorSideLeft.Control = InBtn + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = OutBtn + AnchorSideRight.Side = asrBottom + Left = 188 + Height = 12 + Top = 147 + Width = 28 + Anchors = [akTop, akLeft, akRight] + Shape = bsSpacer + end + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 298 + Width = 421 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object CloseBtn: TButton + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 354 + Height = 25 + Top = 314 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 1 + end + object ResetBtn: TButton + AnchorSideTop.Control = CloseBtn + AnchorSideRight.Control = ComputeBtn + Left = 200 + Height = 25 + Top = 314 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 2 + end + object HelpBtn: TButton + AnchorSideTop.Control = CloseBtn + AnchorSideRight.Control = ResetBtn + Left = 137 + Height = 25 + Top = 314 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Right = 12 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 266 + Height = 25 + Top = 314 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/crosstabunit.pas b/applications/lazstats/source/forms/analysis/descriptive/crosstabunit.pas new file mode 100644 index 000000000..43798fb91 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/crosstabunit.pas @@ -0,0 +1,464 @@ +// Use file "twoway.laz" for testing + +unit CrossTabUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + Globals, OutputUnit, MainUnit, DataProcs, MatrixLib, ContextHelpUnit; + +type + + { TCrossTabFrm } + + TCrossTabFrm = class(TForm) + ComputeBtn: TButton; + VertCenterBevel: TBevel; + Bevel2: TBevel; + HelpBtn: TButton; + InBtn: TBitBtn; + OutBtn: TBitBtn; + Panel2: TPanel; + ResetBtn: TButton; + CloseBtn: TButton; + Label1: TLabel; + Label2: TLabel; + VarList: TListBox; + SelList: TListBox; + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + grandsum, sum, index : integer; + no_in_list, length_array, ptr1, ptr2 : integer ; + var_list, min_value, max_value, levels, displace, subscript : IntDyneVec; + freq : IntDyneVec; + outgrid : DblDyneMat; + rowlabels : StrDyneVec; + colLabels : StrDyneVec; + ColNoSelected : IntDyneVec; + NoSelected : integer; + NV, NC : integer; + + procedure Initialize; + procedure GetLevels(AReport: TStrings); + function IndexPosition(x: IntDyneVec): integer; + Procedure Tabulate; + procedure BreakDown(AReport: TStrings); + procedure UpdateBtnStates; + + public + { public declarations } + end; + +var + CrossTabFrm: TCrossTabFrm; + +implementation + +uses + Math; + +{ TCrossTabFrm } + +procedure TCrossTabFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + SelList.Clear; + NV := NoVariables; + NC := NoCases; + for i := 1 to NV do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TCrossTabFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TCrossTabFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TCrossTabFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + SelList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TCrossTabFrm.ComputeBtnClick(Sender: TObject); +var + cellvalue: string; + i, j: integer; + lReport: TStrings; +begin + if SelList.Items.Count = 0 then + begin + MessageDlg('No variables selected for analysis.', mtError, [mbOK], 0); + exit; + end; + + SetLength(var_list, NV); + SetLength(min_value, NV); + SetLength(max_value, NV); + SetLength(levels, NC); + SetLength(displace, NC); + SetLength(subscript,NC); + SetLength(ColNoSelected, NV); + + lReport := TStringList.Create; + try + lReport.Add('CROSSTAB RESULTS'); + lReport.Add(''); + lReport.Add('Analyzed data is from file ' + OS3MainFrm.FileNameEdit.Text); + lReport.Add(''); + + Initialize; + + NoSelected := 0; + for i := 0 to SelList.Items.Count-1 do + begin + for j := 1 to NV do + begin + cellvalue := OS3MainFrm.DataGrid.Cells[j,0]; + if cellvalue = SelList.Items[i] then + begin + var_list[i] := j; + ColNoSelected[i] := j; + NoSelected := NoSelected + 1; + break; + end; + end; + end; + + no_in_list := SelList.Items.Count; + GetLevels(lReport); + Tabulate; + BreakDown(lReport); + + lReport.Add(''); + lReport.Add('Grand sum across all categories = %d', [grandsum]); + + DisplayReport(lReport); + + finally + lReport.Free; + + ColNoSelected := nil; + freq := nil; + collabels := nil; + rowlabels := nil; + outgrid := nil; + subscript := nil; + displace := nil; + levels := nil; + max_value := nil; + min_value := nil; + var_list := nil; + end; +end; + +procedure TCrossTabFrm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < SelList.Items.Count do + begin + if SelList.Selected[i] then + begin + VarList.Items.Add(SelList.Items[i]); + SelList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TCrossTabFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TCrossTabFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TCrossTabFrm.Initialize; +var + i: integer; +begin + no_in_list := 0; + for i := 1 to NV do + begin + var_list[i-1] := 0; + min_value[i-1] := 0; + max_value[i-1] := 0; + levels[i-1] := 0; + displace[i-1] := 0; + subscript[i-1] := 0; + end; + index := 0; + length_array := 0; + grandsum := 0; +end; { initialize procedure } + +procedure TCrossTabFrm.GetLevels(AReport: TStrings); +var + i, j, k: integer; + value: double; +begin + for i := 1 to no_in_list do + begin + j := var_list[i-1]; + if not GoodRecord(1,NoSelected,ColNoSelected) then continue; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[j,1]); + min_value[i-1] := round(value); + max_value[i-1] := round(value); + for k := 2 to NC do + begin + if not GoodRecord(k,NoSelected,ColNoSelected) then continue; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[j,k]); + if value < min_value[i-1] then + min_value[i-1] := round(value); + if value > max_value[i-1] then + max_value[i-1] := round(value); + end; + end; + + for i := 1 to no_in_list do + begin + j := var_list[i-1]; + levels[i-1] := max_value[i-1] - min_value[i-1] + 1; + AReport.Add('%s min.=%3d, max.=%3d, no. levels = %3d', [ + OS3MainFrm.DataGrid.Cells[j,0],min_value[i-1],max_value[i-1],levels[i-1] + ]); + end; + AReport.Add(''); + + displace[no_in_list-1] := 1; + if no_in_list > 1 then + for i := (no_in_list - 1) downto 1 do + displace[i-1] := levels[i] * displace[i]; +end; + +function TCrossTabFrm.IndexPosition(x: IntDyneVec): integer; +var + i: integer; +begin + Result := x[no_in_list-1]; + if no_in_list > 1 then + begin + for i := 1 to no_in_list - 1 do + Result := Result + (x[i-1] -1) * displace[i-1]; + end; +end; + +procedure TCrossTabFrm.Tabulate; +var + i, j, k: integer; + value: double; + x: integer; +begin + length_array := 1; + for i := 1 to no_in_list do + length_array := length_array * levels[i-1]; + SetLength(freq,length_array+1); + + for i := 0 to length_array do + freq[i] := 0; + for i := 1 to NC do + begin + if IsFiltered(i) then + continue; + for j := 1 to no_in_list do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + k := var_list[j-1]; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[k,i]); + x := round(value); + x := x - min_value[j-1] + 1; + subscript[j-1] := x; + end; + j := IndexPosition(subscript); + + if (j < 1) or (j > length_array) then + continue + else + freq[j] := freq[j] + 1; + end; +end; { procedure TABULATE } + +procedure TCrossTabFrm.BreakDown(AReport: TStrings); +label 1,2,3,4, printgrid; +var + i, j, row, col, bigmax: integer; + outline: string; + value: string; + title: String; +begin + bigmax := -1; + for i := 0 to no_in_list-1 do + if Levels[i] > bigmax then bigmax := Levels[i]; + + SetLength(colLabels,bigmax); + SetLength(outgrid,length_array,bigmax); + SetLength(rowlabels,length_array); + outline := OS3MainFrm.DataGrid.Cells[var_list[no_in_list-1], 0]; + for col := 1 to Levels[no_in_list-1] do + collabels[col-1] := outline + Format(':%3d', [min_value[no_in_list-1] + col - 1]); + for row := 1 to length_array do + rowlabels[row-1] := ''; + ptr1 := no_in_list - 1; + ptr2 := no_in_list; + for i := 1 to no_in_list do + subscript[i-1] := 1; + + AReport.Add('FREQUENCIES BY LEVEL:'); + sum := 0; + col := 1; + row := 1; + + 1: + index := IndexPosition(subscript); + outline := 'For cell levels: '; + for i := 1 to no_in_list do + begin + j := var_list[i-1]; + value := Format('%s:%3d ',[OS3MainFrm.DataGrid.Cells[j,0], min_value[i-1] + subscript[i-1] - 1]); + outline := outline + value; + end; + sum := sum + freq[index]; + outgrid[row-1,col-1] := freq[index]; + outline := outline + Format(' Frequency = %3d', [freq[index]]); + AReport.Add(outline); + + subscript[ptr2-1] := subscript[ptr2-1] + 1; + col := col + 1; + if subscript[ptr2-1] <= levels[ptr2-1] then + goto 1; + + AReport.Add('Sum across levels = %3d', [sum]); + AReport.Add(''); + AReport.Add(''); + + grandsum := grandsum + sum; + sum := 0; + row := row + 1; + + 2: + if ptr1 < 1 then + goto printgrid; + + subscript[ptr1-1] := subscript[ptr1-1] + 1; + if subscript[ptr1-1] <= levels[ptr1-1] then + goto 4; + + 3: + ptr1 := ptr1 - 1; + if ptr1 < 1 then + goto printgrid; + if subscript[ptr1-1] >= levels[ptr1-1] then + goto 3; + subscript[ptr1-1] := subscript[ptr1-1] + 1; + + 4: + for i := ptr1 + 1 to no_in_list do + subscript[i-1] := 1; + ptr1 := no_in_list - 1; + col := 1; + + goto 1; + +printgrid: + title := 'Cell Frequencies by Levels'; + for i := 1 to row - 1 do + begin + value := format('Block %d',[i]); + rowlabels[i-1] := value; + end; + + MatPrint(outgrid,row-1,Levels[no_in_list-1],title,rowlabels,collabels,NC, AReport); +end; { Procedure BREAKDOWN } + +procedure TCrossTabFrm.UpdateBtnStates; +var + lSelected: Boolean; + i: Integer; +begin + lSelected := false; + for i := 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + InBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to SelList.Items.Count-1 do + if SelList.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; +end; + +procedure TCrossTabFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + + +initialization + {$I crosstabunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/descriptiveunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/descriptiveunit.lfm new file mode 100644 index 000000000..b9166b2da --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/descriptiveunit.lfm @@ -0,0 +1,305 @@ +object DescriptiveFrm: TDescriptiveFrm + Left = 626 + Height = 393 + Top = 226 + Width = 453 + AutoSize = True + Caption = 'Descriptive Statistics' + ClientHeight = 393 + ClientWidth = 453 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 390 + Height = 25 + Top = 360 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 9 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 244 + Height = 25 + Top = 360 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 8 + end + object HelpBtn: TButton + Tag = 119 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 185 + Height = 25 + Top = 360 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 7 + end + object Label1: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = CIEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = CIEdit + Left = 8 + Height = 15 + Top = 325 + Width = 174 + BorderSpacing.Right = 8 + Caption = 'Confidence Interval for the Mean' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 46 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = SelList + AnchorSideTop.Control = Owner + Left = 257 + Height = 15 + Top = 8 + Width = 44 + BorderSpacing.Top = 8 + Caption = 'Selected' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 208 + Top = 25 + Width = 187 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object SelList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 257 + Height = 208 + Top = 25 + Width = 188 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 4 + end + object CIEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 190 + Height = 23 + Top = 321 + Width = 41 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + TabOrder = 6 + Text = '95.0' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = CIEdit + Left = 8 + Height = 72 + Top = 241 + Width = 306 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 24 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 52 + ClientWidth = 302 + TabOrder = 5 + object CaseChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 138 + BorderSpacing.Left = 12 + BorderSpacing.Right = 12 + Caption = 'Casewise Deletion' + TabOrder = 0 + end + object CheckBox1: TCheckBox + AnchorSideTop.Side = asrBottom + Left = 174 + Height = 19 + Top = 6 + Width = 116 + BorderSpacing.Left = 12 + BorderSpacing.Right = 12 + Caption = 'z Scores to Grid' + TabOrder = 1 + end + object PcntileChk: TCheckBox + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 27 + Width = 138 + BorderSpacing.Left = 12 + BorderSpacing.Right = 12 + Caption = 'Show Percentile Ranks' + TabOrder = 2 + end + object AltQrtilesChk: TCheckBox + AnchorSideTop.Side = asrBottom + Left = 174 + Height = 19 + Top = 27 + Width = 116 + BorderSpacing.Left = 12 + BorderSpacing.Right = 12 + Caption = 'Show All Quartiles' + TabOrder = 3 + end + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + AnchorSideRight.Side = asrBottom + Left = 212 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 212 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = OutBtn + AnchorSideTop.Side = asrBottom + Left = 203 + Height = 25 + Top = 117 + Width = 46 + AutoSize = True + BorderSpacing.Top = 32 + Caption = 'ALL' + OnClick = AllBtnClick + TabOrder = 3 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 344 + Width = 453 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 306 + Height = 25 + Top = 360 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 10 + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/descriptiveunit.pas b/applications/lazstats/source/forms/analysis/descriptive/descriptiveunit.pas new file mode 100644 index 000000000..ddc1ec51e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/descriptiveunit.pas @@ -0,0 +1,473 @@ +unit DescriptiveUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, + MainUnit, Globals, FunctionsLib, OutputUnit, DataProcs, DictionaryUnit, ContextHelpUnit; + + +type + + { TDescriptiveFrm } + + TDescriptiveFrm = class(TForm) + Bevel1: TBevel; + ComputeBtn: TButton; + CaseChk: TCheckBox; + CheckBox1: TCheckBox; + AltQrtilesChk: TCheckBox; + HelpBtn: TButton; + Label2: TLabel; + Label3: TLabel; + PcntileChk: TCheckBox; + GroupBox1: TGroupBox; + InBtn: TBitBtn; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + ResetBtn: TButton; + CloseBtn: TButton; + CIEdit: TEdit; + Label1: TLabel; + VarList: TListBox; + SelList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + + private + { private declarations } + FAutoSized: Boolean; + sum, variance, stddev, value, mean, min, max, range, skew, prob, df, CI : double; + kurtosis, z, semean, seskew, sekurtosis, deviation, devsqr, M2, M3, M4 : double; + Q1, Q2, Q3, Q12, Q13, Q14, Q15, Q16, Q17, Q18, Q22, Q23, Q24, Q25, Q26 : double; + Q27, Q28, Q32, Q33, Q34, Q35, Q36, Q37, Q38, IQrange : double; + ncases, noselected : integer; + cellstring, gridstring: string; + selected : IntDyneVec; + procedure UpdateBtnStates; + + public + { public declarations } + end; + +var + DescriptiveFrm: TDescriptiveFrm; + +implementation + +uses + Math; + +{ TDescriptiveFrm } + +procedure TDescriptiveFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + CIEdit.Text := FormatFloat('0.0', DEFAULT_CONFIDENCE_LEVEL_PERCENT); + VarList.Clear; + SelList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + Selected := nil; + UpdateBtnStates; +end; + +procedure TDescriptiveFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TDescriptiveFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TDescriptiveFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TDescriptiveFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TDescriptiveFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + SelList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TDescriptiveFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, m: integer; + num, den, cases: double; + values, pcntrank: DblDyneVec; + lReport: TStrings; +begin + noselected := SelList.Items.Count; + if noSelected = 0 then + begin + MessageDlg('No variables selected.', mtError, [mbOK], 0); + exit; + end; + + SetLength(Selected, noselected); + + // Get selected variables + for i := 1 to noselected do + begin + cellstring := SelList.Items.Strings[i-1]; + for j := 1 to NoVariables do + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then selected[i-1] := j; + end; + + lReport := TStringList.Create; + try + lReport.Add('DISTRIBUTION PARAMETER ESTIMATES'); + lReport.Add(''); + + SetLength(Values, NoCases); + SetLength(pcntrank, NoCases); + + for j := 1 to noselected do + begin + deviation := 0.0; + devsqr := 0.0; + M2 := 0.0; + M3 := 0.0; + M4 := 0.0; + sum := 0.0; + variance := 0.0; + stddev := 0.0; + range := 0.0; + skew := 0.0; + kurtosis := 0.0; + ncases := 0; + df := 0.0; + seskew := 0.0; + kurtosis := 0.0; + sekurtosis := 0.0; + k := selected[j-1]; + CI := StrToFloat(CIEdit.Text) / 100.0; + prob := CI; + CI := (1.0 - CI) / 2.0; + CI := 1.0 - CI; + + if CheckBox1.Checked then // add a new column to the grid + begin + gridstring := OS3MainFrm.DataGrid.Cells[k,0]; + gridstring := Gridstring + 'z'; + DictionaryFrm.NewVar(NoVariables+1); + DictionaryFrm.DictGrid.Cells[1,NoVariables] := gridstring; + OS3MainFrm.DataGrid.Cells[NoVariables,0] := gridstring; + end; + + // Accumulate sums of squares, sums, etc. for variable j + min := 1.0e308; + max := -1.0e308; + for i := 1 to NoCases do + begin + if not GoodRecord(i,noselected,selected) then + continue; + + if CaseChk.Checked then + begin + if not ValidValue(i,selected[j-1]) then + continue; + end + else if not GoodRecord(i,noselected,selected) then + continue; + + value := StrToFloat(OS3MainFrm.DataGrid.Cells[k,i]); + ncases := ncases + 1; + values[ncases-1] := value; + df := df + 1.0; + sum := sum + value; + variance := variance + (value * value); + if (value < min) then min := value; + if (value > max) then max := value; + end; + + if ncases > 0 then + begin + mean := sum / ncases; + range := max - min; + end; + + if ncases > 1 then + begin + variance := variance - (sum * sum) / ncases; + variance := variance / (ncases - 1); + stddev := sqrt(variance); + semean := sqrt(variance / ncases); + if ncases < 120 then + CI := semean * inverset(CI,df) + else + CI := semean * inversez(CI); + end; + + if variance = 0.0 then + begin + cellstring := OS3MainFrm.DataGrid.Cells[k,0]; + MessageDlg('No Variability in '+ cellstring + ' variable - ending analysis.', mtInformation, [mbOK], 0); + exit; + end; + + if ncases > 3 then // obtain skew, kurtosis and z scores + begin + for i := 1 to NoCases do + begin + if CaseChk.Checked then + begin + if not ValidValue(i,selected[j-1]) then continue; + end else + if not GoodRecord(i,noselected,selected) then continue; + + value := StrToFloat(OS3MainFrm.DataGrid.Cells[k,i]); + if stddev > 0.0 then + begin + deviation := value - mean; + devsqr := deviation * deviation; + M2 := M2 + devsqr; + M3 := M3 + (deviation * devsqr); + M4 := M4 + (devsqr * devsqr); + z := (value - mean) / stddev; + if CheckBox1.Checked then + begin + cellstring := format('%8.5f',[z]); + OS3MainFrm.DataGrid.Cells[NoVariables,i] := cellstring; + end; + end; + end; + + if ncases > 2 then + begin + skew := (ncases * M3) / ((ncases - 1) * (ncases - 2) * stddev * variance); + cases := ncases; + num := 6.0 * cases * (cases - 1.0); + den := (cases - 2.0) * (cases + 1.0) * (cases + 3.0); + seskew := sqrt(num / den); + end; + + if ncases > 3 then + begin + kurtosis := (ncases * (ncases + 1) * M4) - (3 * M2 * M2 * (ncases - 1)); + kurtosis := kurtosis / ( (ncases - 1) * (ncases - 2) * (ncases - 3) * (variance * variance) ); + sekurtosis := sqrt((4.0 * (ncases * ncases - 1) * (seskew * seskew)) / ((ncases - 3) * (ncases + 5))); + end; + end; + + // output results for the kth variable + cellstring := OS3MainFrm.DataGrid.Cells[k,0]; + if j > 1 then lReport.Add(''); + lReport.Add('VARIABLE: %10s', ['"' + cellString + '"']); + lReport.Add(''); + lReport.Add('Number of cases: %10d', [nCases]); + lReport.Add('Sum: %10.3f', [sum]); + lReport.Add('Mean: %10.3f', [mean]); + lReport.Add('Variance: %10.3f', [variance]); + lReport.Add('Std.Dev.: %10.3f', [stddev]); + lReport.Add('Std.Error of Mean %10.3f', [seMean]); + lReport.Add('%.2f%% Conf.Interval Mean: %10.3f to %.3f', [prob*100.0, mean - CI, mean + CI]); + lReport.Add('Range: %10.3f', [range]); + lReport.Add('Minimum: %10.3f', [min]); + lReport.Add('Maximum: %10.3f', [max]); + lReport.Add('Skewness: %10.3f', [skew]); + lReport.Add('Std.Error of Skew: %10.3f', [seSkew]); + lReport.Add('Kurtosis: %10.3f', [kurtosis]); + lReport.Add('Std. Error of Kurtosis: %10.3f', [seKurtosis]); + lReport.Add(''); + + if ncases > 4 then // get percentiles and quartiles + begin + // get percentile ranks + if pcntileChk.Checked then PRank(k, pcntRank); + + // sort values and get quartiles + for i := 0 to ncases - 2 do + begin + for m := i + 1 to ncases -1 do + begin + if values[i] > values[m] then + begin + value := values[i]; + values[i] := values[m]; + values[m] := value; + end; + end; + end; + Q1 := Quartiles(2,0.25,ncases,values); + Q2 := Quartiles(2,0.5,ncases,values); + Q3 := Quartiles(2,0.75,ncases,values); + IQrange := Q3 - Q1; + lReport.Add('First Quartile: %10.3f', [Q1]); + lReport.Add('Median: %10.3f', [Q2]); + lReport.Add('Third Quartile: %10.3f', [Q3]); + lReport.Add('Interquartile range: %10.3f', [IQrange]); + lReport.Add(''); + end; + + if (AltQrtilesChk.Checked) then + begin + lReport.Add('Alternative Methods for Obtaining Quartiles'); + lReport.Add(' Method 1 2 3 4 5 6 7 8'); + lReport.Add('Pcntile'); + Q1 := Quartiles(1,0.25,ncases,values); + Q12 := Quartiles(2,0.25,ncases,values); + Q13 := Quartiles(3,0.25,ncases,values); + Q14 := Quartiles(4,0.25,ncases,values); + Q15 := Quartiles(5,0.25,ncases,values); + Q16 := Quartiles(6,0.25,ncases,values); + Q17 := Quartiles(7,0.25,ncases,values); + Q18 := Quartiles(8,0.25,ncases,values); + lReport.Add('Q1 %8.3f%8.3f%8.3f%8.3f%8.3f%8.3f%8.3f%8.3f', [Q1,Q12,Q13,Q14,Q15,Q16,Q17,Q18]); + Q2 := Quartiles(1,0.5,ncases,values); + Q22 := Quartiles(2,0.5,ncases,values); + Q23 := Quartiles(3,0.5,ncases,values); + Q24 := Quartiles(4,0.5,ncases,values); + Q25 := Quartiles(5,0.5,ncases,values); + Q26 := Quartiles(6,0.5,ncases,values); + Q27 := Quartiles(7,0.5,ncases,values); + Q28 := Quartiles(8,0.5,ncases,values); + lReport.Add('Q2 %8.3f%8.3f%8.3f%8.3f%8.3f%8.3f%8.3f%8.3f', [Q2,Q22,Q23,Q24,Q25,Q26,Q27,Q28]); + Q3 := Quartiles(1,0.75,ncases,values); + Q32 := Quartiles(2,0.75,ncases,values); + Q33 := Quartiles(3,0.75,ncases,values); + Q34 := Quartiles(4,0.75,ncases,values); + Q35 := Quartiles(5,0.75,ncases,values); + Q36 := Quartiles(6,0.75,ncases,values); + Q37 := Quartiles(7,0.75,ncases,values); + Q38 := Quartiles(8,0.75,ncases,values); + lReport.Add('Q3 %8.3f%8.3f%8.3f%8.3f%8.3f%8.3f%8.3f%8.3f', [Q3,Q32,Q33,Q34,Q35,Q36,Q37,Q38]); + lReport.Add('NOTES:'); + lReport.Add('Method 1 is the weighted average at X[np] where n is no. of cases, p is percentile / 100'); + lReport.Add('Method 2 is the weighted average at X[(n+1)p] This is used in this program.'); + lReport.Add('Method 3 is the empirical distribution function.'); + lReport.Add('Method 4 is called the empirical distribution function - averaging.'); + lReport.Add('Method 5 is called the empirical distribution function = Interpolation.'); + lReport.Add('Method 6 is the closest observation method.'); + lReport.Add('Method 7 is from the TrueBasic Statistics Graphics Toolkit.'); + lReport.Add('Method 8 was used in an older Microsoft Excel version.'); + lReport.Add('See the internet site http://www.xycoon.com/ for the above.'); + lReport.Add(''); + end; // end of experimental alternatives + lReport.Add('--------------------------------------------------------------'); + end; // next j variable + + DisplayReport(lReport); + + finally + lReport.Free; + Selected := nil; + Values := nil; + pcntrank := nil; + end; +end; + +procedure TDescriptiveFrm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < SelList.Items.Count do + begin + if SelList.Selected[i] then + begin + VarList.Items.Add(SelList.Items[i]); + SelList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TDescriptiveFrm.AllBtnClick(Sender: TObject); +var + i : integer; +begin + for i := 0 to VarList.Items.Count-1 do + SelList.Items.Add(VarList.Items.Strings[i]); + VarList.Clear; + UpdateBtnStates; +end; + +procedure TDescriptiveFrm.UpdateBtnStates; +var + lSelected: Boolean; + i: Integer; +begin + lSelected := false; + for i := 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + InBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to SelList.Items.Count-1 do + if SelList.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; + + AllBtn.Enabled := VarList.Count > 0; +end; + +procedure TDescriptiveFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + + +initialization + {$I descriptiveunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/freqspecsunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/freqspecsunit.lfm new file mode 100644 index 000000000..1252c0c57 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/freqspecsunit.lfm @@ -0,0 +1,266 @@ +object FreqSpecsFrm: TFreqSpecsFrm + Left = 310 + Height = 331 + Top = 137 + Width = 325 + AutoSize = True + BorderStyle = bsSingle + Caption = 'Frequency Specifications' + ClientHeight = 331 + ClientWidth = 325 + OnActivate = FormActivate + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = VarName + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 84 + Width = 44 + BorderSpacing.Left = 8 + Caption = 'Variable:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Minimum + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 115 + Width = 53 + BorderSpacing.Left = 8 + Caption = 'Minimum' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Maximum + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 146 + Width = 55 + BorderSpacing.Left = 8 + Caption = 'Maximum' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Range + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 177 + Width = 33 + BorderSpacing.Left = 8 + Caption = 'Range' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = IntSize + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 208 + Width = 62 + BorderSpacing.Left = 8 + Caption = 'Interval Size' + ParentColor = False + end + object Label6: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = NoInts + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 239 + Width = 105 + BorderSpacing.Left = 8 + Caption = 'Number of Intervals' + ParentColor = False + end + object VarName: TEdit + AnchorSideLeft.Control = NoInts + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 137 + Height = 23 + Top = 80 + Width = 180 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 0 + end + object Minimum: TEdit + AnchorSideLeft.Control = NoInts + AnchorSideTop.Control = VarName + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 137 + Height = 23 + Top = 111 + Width = 180 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 1 + end + object Maximum: TEdit + AnchorSideLeft.Control = NoInts + AnchorSideTop.Control = Minimum + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 137 + Height = 23 + Top = 142 + Width = 180 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 2 + end + object Range: TEdit + AnchorSideLeft.Control = NoInts + AnchorSideTop.Control = Maximum + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 137 + Height = 23 + Top = 173 + Width = 180 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 3 + end + object IntSize: TEdit + AnchorSideLeft.Control = NoInts + AnchorSideTop.Control = Range + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 137 + Height = 23 + Top = 204 + Width = 180 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + OnKeyPress = IntSizeKeyPress + TabOrder = 4 + end + object NoInts: TEdit + AnchorSideLeft.Control = Label6 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = IntSize + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 137 + Height = 23 + Top = 235 + Width = 180 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 24 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 5 + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = OKBtn + Left = 201 + Height = 25 + Top = 274 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 7 + end + object OKBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 275 + Height = 25 + Top = 274 + Width = 42 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'OK' + ModalResult = 1 + OnClick = OKBtnClick + TabOrder = 8 + end + object HelpBtn: TButton + Tag = 123 + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CancelBtn + Left = 138 + Height = 25 + Top = 274 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 36 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 6 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = NoInts + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 258 + Width = 325 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 60 + Top = 8 + Width = 309 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Around = 8 + Caption = 'The number of intervals must be less than or equal to the number of cases. To change the number of intervals, change the interval size to a larger value. Press the Enter key to make the number of intervals smaller.' + ParentColor = False + WordWrap = True + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/freqspecsunit.pas b/applications/lazstats/source/forms/analysis/descriptive/freqspecsunit.pas new file mode 100644 index 000000000..5161b4cf6 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/freqspecsunit.pas @@ -0,0 +1,149 @@ +unit FreqSpecsUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + ContextHelpUnit; + +type + + { TFreqSpecsFrm } + + TFreqSpecsFrm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + HelpBtn: TButton; + Memo1: TLabel; + OKBtn: TButton; + VarName: TEdit; + Minimum: TEdit; + Maximum: TEdit; + Range: TEdit; + IntSize: TEdit; + NoInts: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + procedure FormActivate(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure IntSizeKeyPress(Sender: TObject; var Key: char); + procedure OKBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + FNoCases: Integer; + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + public + { public declarations } + property NoCases: Integer read FNoCases write FNoCases; + end; + +var + FreqSpecsFrm: TFreqSpecsFrm; + +implementation + +uses + Math; + +{ TFreqSpecsFrm } + +procedure TFreqSpecsFrm.IntSizeKeyPress(Sender: TObject; var Key: char); +var + rangeval : double; + increment : double; +begin + if ord(Key) <> 13 then exit; + rangeval := StrToFloat(Range.Text); + increment := StrToFloat(IntSize.Text); + NoInts.Text := FloatToStr(rangeval / increment); +end; + +procedure TFreqSpecsFrm.OKBtnClick(Sender: TObject); +var + msg: String; + C: TWinControl; +begin + if not Validate(msg, C) then begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + ModalResult := mrNone; + end; +end; + +function TFreqSpecsFrm.Validate(out AMsg: String; + out AControl: TWinControl): Boolean; +var + NoIntervals: Integer; + f: Double; +begin + Result := False; + if IntSize.Text = '' then + begin + AControl := IntSize; + AMsg := 'Interval size is not specified.'; + exit; + end; + if not TryStrToFloat(IntSize.Text, f) then + begin + AControl := IntSize; + AMsg := 'No valid number given for interval size.'; + exit; + end; + if NoInts.Text = '' then + begin + AControl := NoInts; + AMsg := 'Number of intervals not specified.'; + exit; + end; + if not TryStrToInt(NoInts.Text, NoIntervals) then + begin + AControl := NoInts; + AMsg := 'No valid number given for number of intervals.'; + exit; + end; + if NoIntervals + 1 > NoCases then begin + AControl := NoInts; + AMsg := Format('Number of intervals cannot be greater than the number of cases (%d).', [NoCases]); + exit; + end; + Result := true; +end; + +procedure TFreqSpecsFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([OKBtn.Width, CancelBtn.Width, HelpBtn.Width]); + OKBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + HelpBtn.Constraints.MinWidth := w; + Constraints.MinHeight := Height; + Constraints.MaxHeight := Height; + HelpBtn.BorderSpacing.Left := NoInts.Left; + + FAutoSized := true; +end; + +procedure TFreqSpecsFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +initialization + {$I freqspecsunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/frequnit.lfm b/applications/lazstats/source/forms/analysis/descriptive/frequnit.lfm new file mode 100644 index 000000000..21519c87a --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/frequnit.lfm @@ -0,0 +1,283 @@ +object FreqFrm: TFreqFrm + Left = 490 + Height = 388 + Top = 228 + Width = 502 + Caption = 'Frequency Distribution' + ClientHeight = 388 + ClientWidth = 502 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object PlotOptionsGroup: TRadioGroup + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 346 + Height = 222 + Top = 8 + Width = 148 + Anchors = [akTop, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Plot Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 202 + ClientWidth = 144 + ItemIndex = 0 + Items.Strings = ( + '2D Vertical Bars' + '3D Vertical Bars' + '2D Pie Chart' + 'Exploded Pie Chart' + '2D Line Chart' + '3D Line Chart' + 'Plot 2D Points' + 'Plot 3D Points' + '2D Horizontal Bars' + '3D Horizontal Bars' + ) + OnSelectionChanged = PlotOptionsGroupSelectionChanged + TabOrder = 1 + end + object BarTypeGroup: TRadioGroup + AnchorSideLeft.Control = PlotOptionsGroup + AnchorSideTop.Control = PlotOptionsGroup + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = PlotOptionsGroup + AnchorSideRight.Side = asrBottom + Left = 346 + Height = 70 + Top = 242 + Width = 148 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Top = 12 + Caption = 'Bar Type' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 50 + ClientWidth = 144 + Enabled = False + ItemIndex = 0 + Items.Strings = ( + 'Separated' + 'Contiguous' + ) + TabOrder = 2 + end + object NormPltChk: TCheckBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 19 + Top = 320 + Width = 149 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Plot Normal Distribution' + TabOrder = 3 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = PlotOptionsGroup + AnchorSideBottom.Control = NormPltChk + Left = 8 + Height = 304 + Top = 8 + Width = 330 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 304 + ClientWidth = 330 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = SelList + AnchorSideTop.Control = Panel1 + Left = 196 + Height = 15 + Top = 0 + Width = 104 + Caption = 'Variables to Analyze' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 287 + Top = 17 + Width = 134 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object SelList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 196 + Height = 287 + Top = 17 + Width = 134 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + OnSelectionChange = SelListSelectionChange + TabOrder = 4 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + Left = 151 + Height = 28 + Top = 23 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + Left = 151 + Height = 28 + Top = 56 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + Left = 142 + Height = 25 + Top = 136 + Width = 46 + AutoSize = True + Caption = 'ALL' + OnClick = AllBtnClick + TabOrder = 3 + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 339 + Width = 502 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object ResetBtn: TButton + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 289 + Height = 25 + Top = 355 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 4 + end + object CloseBtn: TButton + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 435 + Height = 25 + Top = 355 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 1 + TabOrder = 5 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 351 + Height = 25 + Top = 355 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/frequnit.pas b/applications/lazstats/source/forms/analysis/descriptive/frequnit.pas new file mode 100644 index 000000000..2fc717112 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/frequnit.pas @@ -0,0 +1,443 @@ +// Use "cansas.laz" for testing. + +unit FreqUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + Globals, MainUnit, OutputUnit, FunctionsLib, GraphLib, DataProcs; + +type + + { TFreqFrm } + + TFreqFrm = class(TForm) + Bevel1: TBevel; + ComputeBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + CloseBtn: TButton; + NormPltChk: TCheckBox; + InBtn: TBitBtn; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + Label1: TLabel; + Label2: TLabel; + SelList: TListBox; + PlotOptionsGroup: TRadioGroup; + BarTypeGroup: TRadioGroup; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure PlotOptionsGroupSelectionChanged(Sender: TObject); + procedure SelListSelectionChange(Sender: TObject; User: boolean); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + FreqFrm: TFreqFrm; + +implementation + +uses + Math, + FreqSpecsUnit; + +{ TFreqFrm } + +procedure TFreqFrm.ResetBtnClick(Sender: TObject); +var + i: integer; + +begin + VarList.Clear; + SelList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + BarTypeGroup.ItemIndex := 0; + PlotOptionsGroup.ItemIndex := 0; + NormPltChk.Checked := false; + UpdateBtnStates; +end; + +procedure TFreqFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + Panel1.Constraints.MinHeight := BarTypeGroup.Top + BarTypeGroup.Height - Panel1.Top; + Panel1.Constraints.MinWidth := Label2.Width * 2 + AllBtn.Width + 2 * VarList.BorderSpacing.Right; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + FAutoSized := true; +end; + +procedure TFreqFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + + if FreqSpecsFrm = nil then + Application.CreateForm(TFreqSpecsFrm, FreqSpecsFrm); + + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TFreqFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TFreqFrm.AllBtnClick(Sender: TObject); +var + count, index : integer; +begin + count := VarList.Items.Count; + for index := 0 to count-1 do + SelList.Items.Add(VarList.Items[index]); + VarList.Clear; + UpdateBtnStates; +end; + +procedure TFreqFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if (VarList.Selected[i]) then + begin + SelList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + i := i + 1; + end; + UpdateBtnStates; +end; + +procedure TFreqFrm.SelListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TFreqFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k : integer; + freq : DblDyneVec; + pcnt : DblDyneVec; + cumpcnt : DblDyneVec; + pcntilerank : DblDyneVec; + cumfreq : DblDyneVec; + XValue : DblDyneVec; + value : double; + NoVars : integer; + plottype : integer; + cellval : string; + col : integer; + min, max : double; + range : double; + incrsize : double; + nointervals : double; + nints : integer; +// ColNoSelected : IntDyneVec; + NormDist : boolean; + Histogram : boolean; + Sumx, Sumx2, Mean, Variance, StdDev, zlow, zhi : double; + X, zproplow, zprophi, zfreq : double; + Ncases : integer; + lReport: TStrings; + +begin + if BarTypeGroup.ItemIndex = 1 then Histogram := true else Histogram := false; + if NormPltChk.Checked = true then NormDist := true else NormDist := false; + + SetLength(freq,NoCases); + SetLength(pcnt,NoCases); + SetLength(cumpcnt,NoCases); + SetLength(pcntilerank,NoCases); + SetLength(cumfreq,NoCases); + SetLength(XValue,NoCases); + + lReport := TStringList.Create; + try + lReport.Add('FREQUENCY ANALYSIS BY BILL MILLER'); + lReport.Add(''); + + { Analyze each variable } + NoVars := SelList.Items.Count; + for i := 1 to NoVars do + begin + { get column no. of variable } + col := 1; + cellval := SelList.Items.Strings[i-1]; + for j := 1 to NoVariables do + begin + if OS3MainFrm.DataGrid.Cells[j,0] = cellval then + begin + col := j; + lReport.Add('Frequency Analysis for Variable "%s"', [cellval]); + break; + end; + end; + + { get min and max values for variable in col } + min := 1.0e32; + max := -1.0e32; + for j := 1 to NoCases do + begin + if not ValidValue(j,col) then continue; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[col,j]); + if value > max then max := value; + if value < min then min := value; + end; + range := max - min + 1.0; + incrsize := 1.0; + { if too many increments, set increment size for 15 increments } + if range > 200.0 then incrsize := range / 15; + nointervals := range / incrsize; + nints := round(nointervals); + + { Get user's approval and / or changes } + FreqSpecsFrm.VarName.Text := cellval; + FreqSpecsFrm.Minimum.Text := FloatToStr(min); + FreqSpecsFrm.Maximum.Text := FloatToStr(max); + FreqSpecsFrm.range.Text := FloatToStr(range); + FreqSpecsFrm.IntSize.Text := FloatToStr(incrsize); + FreqSpecsFrm.NoInts.Text := IntToStr(nints); + FreqSpecsFrm.NoCases := NoCases; + if FreqSpecsFrm.ShowModal <> mrOK then + exit; + + incrsize := StrToFloat(FreqSpecsFrm.IntSize.Text); + nints := StrToInt(FreqSpecsFrm.NoInts.Text); + if nints > 200 then + nints := 200; + + {Now, get frequency of cases in each interval } + for j := 1 to nints+1 do + freq[j-1] := 0; + Ncases := 0; + for j := 1 to NoCases do + begin + if not ValidValue(j,col) then continue; + inc(Ncases); + value := StrToFloat(OS3MainFrm.DataGrid.Cells[col,j]); + for k := 1 to nints do + begin + if (value >= min + ((k-1) * incrsize)) and + (value < min + (k * incrsize)) then freq[k-1] := freq[k-1] + 1; + end; + end; + for j := 1 to nints+1 do + XValue[j-1] := min + (j-1) * incrsize; + + { get cumulative frequencies and percents to midpoints } + cumfreq[0] := freq[0]; + pcnt[0] := freq[0] / Ncases; + cumpcnt[0] := cumfreq[0] / Ncases; + pcntilerank[0] := (freq[0] / 2.0) / Ncases; + for k := 2 to nints do + begin + cumfreq[k-1] := cumfreq[k-2] + freq[k-1]; + pcnt[k-1] := freq[k-1] / Ncases; + cumpcnt[k-1] := cumfreq[k-1] / Ncases; + pcntilerank[k-1] := (cumfreq[k-2] + freq[k-1] / 2.0) / Ncases; + end; + + { Now, print results to report } + lReport.Add(' FROM TO FREQ. PCNT CUM.FREQ. CUM.PCNT. %ILE RANK'); + lReport.Add(''); + for k := 1 to nints do + lReport.Add('%8.2f%8.2f%8.0f%8.2f %8.2f %8.2f %8.2f', [ + min+(k-1)*incrsize, // from + min+k*incrsize, // to + freq[k-1], // freq + pcnt[k-1], // pcnt + cumfreq[k-1], // cum.freq. + cumpcnt[k-1], // cum.pcnt. + pcntilerank[k-1] // %ile rank + ]); + + { Now, prepare plot values as indicated in options list } + if NormDist = false then + SetLength(GraphFrm.Ypoints,1,nints+1) + else + SetLength(GraphFrm.Ypoints,2,nints+1); + SetLength(GraphFrm.Xpoints,1,nints+1); + for k := 1 to nints+1 do + begin + GraphFrm.Ypoints[0,k-1] := freq[k-1]; + GraphFrm.Xpoints[0,k-1] := XValue[k-1]; + end; + + // Create ND plot if checked. + // BUT: Only 3D-vertical plots when normal curve is desired + if NormDist then + begin + lReport.Add(''); + lReport.Add('Interval ND Freq.'); + // Only use 3Dvertical plots when normal curve desired + PlotOptionsGroup.ItemIndex := 1; + // get mean and standard deviation of xvalues, then height of + // the normal curve for each Normally distributed corresponding z score + sumx := 0.0; + sumx2 := 0.0; + for k := 1 to nints do + begin + sumx := sumx + (XValue[k-1] * freq[k-1]); + sumx2 := sumx2 + ((XValue[k-1] * XValue[k-1]) * freq[k-1]); + end; + Mean := sumx / Ncases; + Variance := sumx2 - ((sumx * sumx) / Ncases); + Variance := Variance / (Ncases - 1); + StdDev := sqrt(Variance); + for k := 1 to nints+1 do + begin + X := XValue[k-1] - (incrsize / 2.0); + if StdDev > 0.0 then + zlow := (X - Mean) / StdDev + else + zlow := 0.0; + X := XValue[k-1] + (incrsize / 2.0); + if StdDev > 0.0 then + zhi := (X - Mean) / StdDev + else + zhi := 0.0; + + // get cum. prop. for this z and translate to frequency + zproplow := probz(zlow); + zprophi := probz(zhi); + zfreq := NoCases * abs(zprophi - zproplow); + GraphFrm.Ypoints[1,k-1] := zfreq; + lReport.Add(' %2d %6.2f', [k, GraphFrm.Ypoints[1,k-1]]); + end; + end; + + // Show report in form + DisplayReport(lReport); + + // Plot data + plottype := PlotOptionsGroup.ItemIndex + 1; + if Histogram then + GraphFrm.barwideprop := 1.0 + else + GraphFrm.barwideprop := 0.5; + if NormDist then + GraphFrm.nosets := 2 + else + GraphFrm.nosets := 1; + GraphFrm.nbars := nints+1; + GraphFrm.Heading := cellval; + GraphFrm.XTitle := 'Lower Limit Values'; + GraphFrm.YTitle := 'Frequency'; + GraphFrm.AutoScaled := true; + GraphFrm.GraphType := plotType; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + if plotType in [2, 6, 8, 10] then + begin + GraphFrm.ShowLeftWall := true; + GraphFrm.ShowRightWall := true; + GraphFrm.ShowBottomWall := true; + end; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + end; // for novars list + + finally + lReport.Free; + XValue := nil; + cumfreq := nil; + pcntilerank := nil; + cumpcnt := nil; + pcnt := nil; + freq := nil; + end; +end; + +procedure TFreqFrm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < SelList.Items.Count do + begin + if (SelList.Selected[i]) then + begin + VarList.Items.Add(SelList.Items[i]); + SelList.Items.Delete(i); + i := 0; + end else + i := i + 1; + end; + UpdateBtnStates; +end; + +procedure TFreqFrm.PlotOptionsGroupSelectionChanged(Sender: TObject); +begin + BarTypeGroup.Enabled := PlotOptionsGroup.ItemIndex in [0, 1, 8, 9]; // Bar series only +end; + +procedure TFreqFrm.UpdateBtnStates; +var + lSelected: Boolean; + i: Integer; +begin + lSelected := false; + for i := 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + Break; + end; + InBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to SelList.Items.Count-1 do + if SelList.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; + + AllBtn.Enabled := VarList.Items.Count > 0; +end; + +procedure TFreqFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I frequnit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/groupfrequnit.lfm b/applications/lazstats/source/forms/analysis/descriptive/groupfrequnit.lfm new file mode 100644 index 000000000..9712c7273 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/groupfrequnit.lfm @@ -0,0 +1,219 @@ +object GroupFreqForm: TGroupFreqForm + Left = 513 + Height = 341 + Top = 233 + Width = 444 + AutoSize = True + Caption = 'Group Frequency Analysis' + ClientHeight = 341 + ClientWidth = 444 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 84 + Width = 100 + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + Caption = 'Available Variables:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = GrpInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = GrpVarEdit + Left = 237 + Height = 15 + Top = 109 + Width = 77 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 12 + BorderSpacing.Bottom = 2 + Caption = 'Group Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GrpInBtn + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 191 + Top = 101 + Width = 181 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object GrpInBtn: TBitBtn + AnchorSideLeft.Control = PlotOptionsBox + AnchorSideTop.Control = VarList + Left = 197 + Height = 28 + Top = 101 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = GrpInBtnClick + Spacing = 0 + TabOrder = 1 + end + object GrpOutBtn: TBitBtn + AnchorSideLeft.Control = GrpInBtn + AnchorSideTop.Control = GrpInBtn + AnchorSideTop.Side = asrBottom + Left = 197 + Height = 28 + Top = 133 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = GrpOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object GrpVarEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GrpOutBtn + AnchorSideBottom.Side = asrBottom + Left = 237 + Height = 23 + Top = 126 + Width = 199 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'GrpVarEdit' + end + object ResetBtn: TButton + AnchorSideTop.Control = CloseBtn + AnchorSideRight.Control = ComputeBtn + Left = 235 + Height = 25 + Top = 308 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object ComputeBtn: TButton + AnchorSideTop.Control = CloseBtn + AnchorSideRight.Control = CloseBtn + Left = 297 + Height = 25 + Top = 308 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 381 + Height = 25 + Top = 308 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 7 + end + object PlotOptionsBox: TRadioGroup + AnchorSideLeft.Control = GrpInBtn + AnchorSideTop.Control = GrpOutBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 197 + Height = 114 + Top = 177 + Width = 239 + Anchors = [akTop, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + Caption = 'Plot Options:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 94 + ClientWidth = 235 + Items.Strings = ( + 'Plot means using 2D Horizontal Bars' + 'Plot means using 3D Horizontal Bars' + 'Plot means using 2D Vertical Bars' + 'Plot means using 3D Vertical Bars' + ) + TabOrder = 4 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 292 + Width = 444 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 60 + Top = 8 + Width = 428 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'This procedure plots the frequency of cases in each of the groups in a group variable. The group variable should be defined as an integer variable.'#13#10#13#10'Select the variable and type of plot and click the Compute button for the results.' + ParentColor = False + WordWrap = True + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/groupfrequnit.pas b/applications/lazstats/source/forms/analysis/descriptive/groupfrequnit.pas new file mode 100644 index 000000000..b315d0327 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/groupfrequnit.pas @@ -0,0 +1,235 @@ +unit GroupFreqUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, GraphLib, Globals, DataProcs; + +type + + { TGroupFreqForm } + + TGroupFreqForm = class(TForm) + Bevel1: TBevel; + GrpInBtn: TBitBtn; + GrpOutBtn: TBitBtn; + ComputeBtn: TButton; + GrpVarEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Memo1: TLabel; + PlotOptionsBox: TRadioGroup; + ResetBtn: TButton; + CloseBtn: TButton; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure GrpInBtnClick(Sender: TObject); + procedure GrpOutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + GroupFreqForm: TGroupFreqForm; + +implementation + +uses + Math; + +{ TGroupFreqForm } + +procedure TGroupFreqForm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + GrpVarEdit.Text := ''; + UpdateBtnStates; +end; + +procedure TGroupFreqForm.GrpInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (GrpVarEdit.Text = '') then + begin + GrpVarEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TGroupFreqForm.ComputeBtnClick(Sender: TObject); +VAR + nogroups, mingrp, maxgrp, grpcol, value, minfreq, maxfreq: integer; + labelstr: string; + i: integer; + strvalue: string; + freq: IntDyneVec; + plottype: integer; +begin + // get the variable to analyze + grpcol := 0; + for i := 1 to NoVariables do + begin + strvalue := OS3MainFrm.DataGrid.Cells[i,0]; + if GrpVarEdit.Text = strvalue then + begin + grpcol := i; + break; + end; + end; + if grpcol = 0 then + begin + MessageDlg('No variable selected.', mtError, [mbOK], 0); + exit; + end; + + labelstr := GrpVarEdit.Text; + mingrp := 1000; + maxgrp := -1000; + for i := 1 to NoCases do + begin + if not ValidValue(i,grpcol) then continue; + value := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[grpcol,i]))); + if value < mingrp then mingrp := value; + if value > maxgrp then maxgrp := value; + end; + nogroups := maxgrp - mingrp + 1; + if nogroups < 2 then + begin + MessageDlg('One or fewer groups found.', mtError, [mbOK], 0); + exit; + end; + + // setup frequency array and count cases in each group + SetLength(freq,NoGroups+1); + for i := 0 to NoGroups do + freq[i] := 0; + for i := 1 to NoCases do + begin + if not ValidValue(i,grpcol) then continue; + value := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[grpcol,i]))); + value := value - mingrp; + freq[value] := freq[value] + 1; + end; + + // get min and max frequencies and check for existence of a range + minfreq := 10000; + maxfreq := -10000; + for i := 0 to NoGroups-1 do + begin + if freq[i] < minfreq then minfreq := freq[i]; + if freq[i] > maxfreq then maxfreq := freq[i]; + end; + if minfreq = maxfreq then + begin + MessageDlg('All groups have equal frequencies. Cannot plot.', mtInformation, [mbOK], 0); + freq := nil; + exit; + end; + + case PlotOptionsBox.ItemIndex of + 0: plottype := 9; + 1: plottype := 10; + 2: plottype := 1; + 3: plottype := 2; + end; + + // plot the frequencies + SetLength(GraphFrm.Xpoints,1,nogroups+1); + SetLength(GraphFrm.Ypoints,1,nogroups+1); + GraphFrm.nosets := 1; + GraphFrm.nbars := nogroups; + GraphFrm.Heading := 'Frequency Distribution'; + GraphFrm.XTitle := 'Values of ' + labelstr; + GraphFrm.YTitle := 'Frequency'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxfreq; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clCream; // clYellow; + GraphFrm.WallColor := clDkGray; //Black; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + for i := 0 to nogroups do + begin + GraphFrm.Ypoints[0,i] := freq[i]; + GraphFrm.Xpoints[0,i] := mingrp + i; + end; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +procedure TGroupFreqForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinHeight := PlotOptionsBox.Top + PlotOptionsBox.Height - VarList.Top; + Varlist.Constraints.MinWidth := Label1.Width * 3 div 2; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TGroupFreqForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if GraphFrm = nil then Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TGroupFreqForm.GrpOutBtnClick(Sender: TObject); +begin + if GrpVarEdit.Text <> '' then + begin + VarList.Items.Add(GrpVarEdit.Text); + GrpVarEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TGroupFreqForm.UpdateBtnStates; +begin + GrpInBtn.Enabled := VarList.ItemIndex > -1; + GrpOutBtn.Enabled := (GrpVarEdit.Text <> ''); +end; + +procedure TGroupFreqForm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + + +initialization + {$I groupfrequnit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/multxvsyunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/multxvsyunit.lfm new file mode 100644 index 000000000..4486ed661 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/multxvsyunit.lfm @@ -0,0 +1,421 @@ +object MultXvsYFrm: TMultXvsYFrm + Left = 814 + Height = 416 + Top = 216 + Width = 395 + Anchors = [akLeft] + AutoSize = True + Caption = 'Multiple X Versus Y Plot' + ClientHeight = 416 + ClientWidth = 395 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Bevel1: TBevel + AnchorSideTop.Control = LabelEdit + Left = 0 + Height = 8 + Top = 367 + Width = 395 + Align = alBottom + Shape = bsBottomLine + end + object Panel2: TPanel + Left = 8 + Height = 328 + Top = 8 + Width = 379 + Align = alClient + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 328 + ClientWidth = 379 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Panel2 + Left = 0 + Height = 15 + Top = 0 + Width = 100 + Caption = 'Available Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 311 + Top = 17 + Width = 190 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object Panel1: TPanel + AnchorSideTop.Control = VarList + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 198 + Height = 310 + Top = 17 + Width = 181 + Anchors = [akTop, akRight] + AutoSize = True + BevelOuter = bvNone + ClientHeight = 310 + ClientWidth = 181 + TabOrder = 1 + object Label2: TLabel + AnchorSideLeft.Control = XEdit + AnchorSideBottom.Control = XEdit + Left = 36 + Height = 15 + Top = 8 + Width = 51 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'X Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = YEdit + AnchorSideBottom.Control = YEdit + Left = 36 + Height = 15 + Top = 92 + Width = 51 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Y Variable' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = GroupEdit + AnchorSideBottom.Control = GroupEdit + Left = 36 + Height = 15 + Top = 176 + Width = 77 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Group Variable' + ParentColor = False + end + object XInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 28 + Top = 0 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = XInBtnClick + Spacing = 0 + TabOrder = 0 + end + object XOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = XInBtn + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 32 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = XOutBtnClick + Spacing = 0 + TabOrder = 1 + end + object YInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = XOutBtn + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 84 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = YInBtnClick + Spacing = 0 + TabOrder = 3 + end + object YOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = YInBtn + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 116 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = YOutBtnClick + Spacing = 0 + TabOrder = 4 + end + object GroupInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = YOutBtn + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 168 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = GroupInBtnClick + Spacing = 0 + TabOrder = 6 + end + object GroupOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = GroupInBtn + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 28 + Top = 200 + Width = 28 + BorderSpacing.Top = 4 + BorderSpacing.Bottom = 8 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = GroupOutBtnClick + Spacing = 0 + TabOrder = 7 + end + object XEdit: TEdit + AnchorSideLeft.Control = XInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = XOutBtn + AnchorSideBottom.Side = asrBottom + Left = 36 + Height = 23 + Top = 25 + Width = 145 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 2 + Text = 'XEdit' + end + object YEdit: TEdit + AnchorSideLeft.Control = XInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = YOutBtn + AnchorSideBottom.Side = asrBottom + Left = 36 + Height = 23 + Top = 109 + Width = 145 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 5 + Text = 'YEdit' + end + object GroupEdit: TEdit + AnchorSideLeft.Control = XInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupOutBtn + AnchorSideBottom.Side = asrBottom + Left = 36 + Height = 23 + Top = 193 + Width = 145 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 8 + Text = 'GroupEdit' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = GroupOutBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 70 + Top = 240 + Width = 181 + AutoSize = True + BorderSpacing.Top = 12 + Caption = 'Options:' + ClientHeight = 50 + ClientWidth = 177 + TabOrder = 9 + object DescChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + Left = 12 + Height = 19 + Top = 2 + Width = 159 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 2 + Caption = 'Show Descriptive Statistics' + TabOrder = 0 + end + object LinesChk: TCheckBox + AnchorSideLeft.Control = DescChk + AnchorSideTop.Control = DescChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 23 + Width = 157 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Connect Points with Lines' + TabOrder = 1 + end + end + end + end + object Panel3: TPanel + Left = 0 + Height = 41 + Top = 375 + Width = 395 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + ClientHeight = 41 + ClientWidth = 395 + TabOrder = 2 + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Side = asrBottom + Left = 178 + Height = 25 + Top = 8 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Side = asrBottom + Left = 244 + Height = 25 + Top = 8 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object CloseBtn: TButton + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 332 + Height = 25 + Top = 8 + Width = 55 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 3 + end + object HelpBtn: TButton + Tag = 134 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Side = asrBottom + Left = 115 + Height = 25 + Top = 8 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 0 + end + end + object Panel4: TPanel + Left = 8 + Height = 23 + Top = 344 + Width = 379 + Align = alBottom + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 23 + ClientWidth = 379 + TabOrder = 1 + object Label5: TLabel + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = LabelEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 4 + Width = 46 + Caption = 'Plot Title' + ParentColor = False + end + object LabelEdit: TEdit + AnchorSideLeft.Control = Label5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel4 + AnchorSideRight.Control = Panel4 + AnchorSideRight.Side = asrBottom + Left = 54 + Height = 23 + Top = 0 + Width = 325 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + TabOrder = 0 + TextHint = 'Text above the plot' + end + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/multxvsyunit.pas b/applications/lazstats/source/forms/analysis/descriptive/multxvsyunit.pas new file mode 100644 index 000000000..3397fb8cc --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/multxvsyunit.pas @@ -0,0 +1,509 @@ +// Use file "BubblePlot2.laz" for testing + +unit MultXvsYUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, Clipbrd, + MainUnit, Globals, OutputUnit, DataProcs, DictionaryUnit, ContextHelpUnit; + +type + + { TMultXvsYFrm } + + TMultXvsYFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + Panel4: TPanel; + XInBtn: TBitBtn; + XOutBtn: TBitBtn; + YInBtn: TBitBtn; + YOutBtn: TBitBtn; + GroupInBtn: TBitBtn; + GroupOutBtn: TBitBtn; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + DescChk: TCheckBox; + LinesChk: TCheckBox; + XEdit: TEdit; + YEdit: TEdit; + GroupEdit: TEdit; + GroupBox1: TGroupBox; + LabelEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure GroupInBtnClick(Sender: TObject); + procedure GroupOutBtnClick(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + procedure XInBtnClick(Sender: TObject); + procedure XOutBtnClick(Sender: TObject); + procedure YInBtnClick(Sender: TObject); + procedure YOutBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure PlotXY(var XValues: DblDyneMat; YValues: DblDyneMat; + MaxX, MinX, MaxY, MinY: double; N, NoY, MinGrp: integer); + procedure UpdateBtnStates; + + public + { public declarations } + end; + +var + MultXvsYFrm: TMultXvsYFrm; + +implementation + +uses + Math, + BlankFrmUnit; + +{ TMultXvsYFrm } + +procedure TMultXvsYFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + XEdit.Text := ''; + YEdit.Text := ''; + GroupEdit.Text := ''; + DescChk.Checked := false; + LinesChk.Checked := false; + XInBtn.Enabled := true; + YInBtn.Enabled := true; + GroupInBtn.Enabled := true; + XOutBtn.Enabled := false; + YOutBtn.Enabled := false; + GroupOutBtn.Enabled := false; +end; + +procedure TMultXvsYFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TMultXvsYFrm.GroupInBtnClick(Sender: TObject); +var + i: integer; +begin + i := VarList.ItemIndex; + if (i > -1) and (GroupEdit.Text = '') then + begin + GroupEdit.Text := VarList.Items[i]; + VarList.Items.Delete(i); + end; + UpdateBtnStates; +end; + +procedure TMultXvsYFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, N, NoGrps, XCol, YCol, GrpCol, Grp, MinGrp, MaxGrp: integer; + NoSelected, MaxGrpSize: integer; + selected, NoInGrp: IntDyneVec; + YValues, XValues: DblDyneMat; + Means, StdDevs: DblDyneVec; + MinX, MaxX, MinY, MaxY, X, Y, temp: double; + cellstring: string; + lReport: TStrings; +begin + MaxGrpSize := 0; + SetLength(selected, 3); + MaxX := -1.0e308; + MinX := 1.0e308; + MaxY := -1.0e308; + MinY := 1.0e308; + MinGrp := MaxInt; + MaxGrp := -MaxInt; + XCol := 0; + YCol := 0; + GrpCol := 0; + N := 0; + + // Get selected variables + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = XEdit.Text) then selected[0] := i; + if (cellstring = YEdit.Text) then selected[1] := i; + if (cellstring = GroupEdit.Text) then selected[2] := i; + end; + + XCol := selected[0]; + YCol := selected[1]; + GrpCol := selected[2]; + NoSelected := 3; + + if (XCol = 0) or (YCol = 0) or (GrpCol = 0) then + begin + MessageDlg('No variable selected.', mtError, [mbOK], 0); + exit; + end; + + // Get number of groups + for i := 1 to NoCases do + begin + Grp := StrToInt(OS3MainFrm.DataGrid.Cells[GrpCol,i]); + if (Grp > MaxGrp) then MaxGrp := Grp; + if (Grp < MinGrp) then MinGrp := Grp; + end; + NoGrps := (MaxGrp - MinGrp) + 1; + + lReport := TStringList.Create; + try + lReport.Add('X VERSUS Y FOR GROUPS PLOT'); + lReport.Add(''); + + SetLength(YValues, NoCases+1, NoGrps+1); + SetLength(XValues, NoCases+1, NoGrps+1); + SetLength(Means, 2); + SetLength(StdDevs, 2); + SetLength(NoInGrp, NoGrps); + + for i := 0 to 1 do + begin + Means[i] := 0.0; + StdDevs[i] := 0.0; + end; + for i := 0 to NoGrps - 1 do + NoInGrp[i] := 0; + + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,selected))then continue; + inc(N); + X := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,i]); + if (X > MaxX) then MaxX := X; + if (X < MinX) then MinX := X; + + Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,i]); + if (Y > MaxY) then MaxY := Y; + if (Y < MinY) then MinY := Y; + + Grp := StrToInt(OS3MainFrm.DataGrid.Cells[GrpCol,i]); + Grp := Grp - MinGrp; + NoInGrp[Grp] := NoInGrp[Grp] + 1; + if (NoInGrp[Grp] > MaxGrpSize) then MaxGrpSize := NoInGrp[Grp]; + YValues[NoInGrp[Grp]-1,Grp] := Y; + XValues[NoInGrp[Grp]-1,Grp] := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,i]); + end; + + // get descriptive data + if (DescChk.Checked) then + begin + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,selected)) then continue; + Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,i]); + X := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,i]); + Means[0] := Means[0] + X; + StdDevs[0] := StdDevs[0] + X * X; + Means[1] := Means[1] + Y; + StdDevs[1] := StdDevs[1] + Y * Y; + end; + + for i := 0 to 1 do + begin + StdDevs[i] := StdDevs[i] - (Means[i] * Means[i]) / N; + StdDevs[i] := sqrt(StdDevs[i] / (N - 1)); + Means[i] := Means[i] / N; + end; + + lReport.Add('VARIABLE MEAN STANDARD DEVIATION'); + lReport.Add(' X %9.3f %14.3f', [Means[0], StdDevs[0]]); + lReport.Add(' Y %9.3f %14.3f', [Means[1], StdDevs[1]]); + lReport.Add(''); + + DisplayReport(lReport); + end; + + // sort on X + for i := 0 to NoGrps - 1 do + begin + for j := 0 to MaxGrpSize-2 do + begin + for k := j+1 to MaxGrpSize - 1 do + begin + if (XValues[j,i] > XValues[k,i]) then // swap + begin + temp := XValues[j,i]; + XValues[j,i] := XValues[k,i]; + XValues[k,i] := temp; + temp := YValues[j,i]; + YValues[j,i] := YValues[k,i]; + YValues[k,i] := temp; + end; + end; + end; + end; + + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Show; + PlotXY(XValues, YValues, MaxX, MinX, MaxY, MinY, MaxGrpSize, NoGrps, MinGrp); + + finally + lReport.Free; + NoInGrp := nil; + StdDevs := nil; + Means := nil; + XValues := nil; + YValues := nil; + end; +end; + +procedure TMultXvsYFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TMultXvsYFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm); + if BlankFrm = nil then Application.CreateForm(TBlankFrm, BlankFrm); +end; + +procedure TMultXvsYFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TMultXvsYFrm.GroupOutBtnClick(Sender: TObject); +begin + if GroupEdit.Text <> '' then + begin + VarList.Items.Add(GroupEdit.Text); + GroupEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TMultXvsYFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TMultXvsYFrm.XInBtnClick(Sender: TObject); +var + i: integer; +begin + i := VarList.ItemIndex; + if (i > -1) and (XEdit.Text = '') then + begin + XEdit.Text := VarList.Items[i]; + VarList.Items.Delete(i); + end; + UpdateBtnStates; +end; + +procedure TMultXvsYFrm.XOutBtnClick(Sender: TObject); +begin + if XEdit.Text <> '' then + begin + VarList.Items.Add(XEdit.Text); + XEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TMultXvsYFrm.YInBtnClick(Sender: TObject); +var + i: integer; +begin + i := VarList.ItemIndex; + if (i > -1) and (YEdit.Text = '') then + begin + YEdit.Text := VarList.Items[i]; + VarList.Items.Delete(i); + end; + UpdateBtnStates; +end; + +procedure TMultXvsYFrm.YOutBtnClick(Sender: TObject); +begin + if YEdit.Text <> '' then + begin + VarList.Items.Add(YEdit.Text); + YEdit.Text := ''; + end; + UpdateBtnStates; +end; + +// routine to plot X versus multiple Y values +procedure TMultXvsYFrm.plotxy(var XValues: DblDyneMat; YValues: DblDyneMat; + MaxX, MinX, MaxY, MinY: double; N, NoY, MinGrp: integer); +var + xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; + vhi, hwide, offset, strhi, imagehi, i, j, Grp : integer; + valincr, Yvalue, Xvalue, value : double; + Title: string; +begin + Title := LabelEdit.Text; + BlankFrm.Caption := Title; + BlankFrm.Show; + + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + vtop := 40; + vbottom := ceil(imagehi) - 60; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + + // Draw chart border and background + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Rectangle(0, 0, imagewide, imagehi); + + // Draw title + if Title <> '' then + begin + xpos := (imagewide - BlankFrm.Image1.Canvas.TextWidth(Title)) div 2; + yPos := 2; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title); + end; + + // draw horizontal axis + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.MoveTo(hleft, vbottom); + BlankFrm.Image1.Canvas.LineTo(hright, vbottom); + valincr := (MaxX - MinX) / 10.0; + for i := 1 to 11 do + begin + ypos := vbottom; + Xvalue := MinX + valincr * (i - 1); + xpos := hLeft + ceil(hwide * ((Xvalue - MinX) / (MaxX - MinX))); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := Format('%.2f', [Xvalue]); + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + xpos := xpos - offset; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title); + end; + xpos := hleft + (hwide - BlankFrm.Image1.Canvas.TextWidth(XEdit.Text)) div 2; + ypos := vbottom + 30; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, XEdit.Text); + + // Draw vertical axis + Title := 'Y VALUES'; + xpos := hleft - BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + ypos := 8; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title); + xpos := hleft; + ypos := vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos, ypos); + ypos := vbottom; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + valincr := (MaxY - MinY) / 10.0; + for i := 1 to 11 do + begin + value := MaxY - ((i-1) * valincr); + Title := Format('%.2f',[value]); + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := hleft - 20 - BlankFrm.Image1.Canvas.TextWidth(Title); + Yvalue := MaxY - (valincr * (i-1)); + ypos := ceil(vhi * ( (MaxY - Yvalue) / (MaxY - MinY))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title); + xpos := hleft; + ypos := ypos + strhi div 2; + BlankFrm.Image1.Canvas.MoveTo(xpos, ypos); + xpos := hleft - 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // draw points for x and y pairs + for j := 0 to NoY - 1 do + begin + BlankFrm.Image1.Canvas.Brush.Style := bsSolid; + BlankFrm.Image1.Canvas.Brush.Color := DATA_COLORS[j mod Length(DATA_COLORS)]; + BlankFrm.Image1.Canvas.Pen.Color := DATA_COLORS[j mod Length(DATA_COLORS)]; + BlankFrm.Image1.Canvas.Font.Color := DATA_COLORS[j mod Length(DATA_COLORS)]; + Grp := MinGrp + j; + Title := 'GROUP ' + IntToStr(Grp); + for i := 1 to N do + begin + ypos := vtop + ceil(vhi * ( (MaxY - YValues[i-1,j]) / (MaxY - MinY))); + xpos := hleft + ceil(hwide * ( (XValues[i-1,j] - MinX) / (MaxX - MinX))); + if (i = 1) then + BlankFrm.Image1.Canvas.MoveTo(xpos, ypos); + if LinesChk.Checked then + BlankFrm.Image1.Canvas.LineTo(xpos, ypos); + BlankFrm.Image1.Canvas.Ellipse(xpos, ypos, xpos+5, ypos+5); + end; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + xpos := hwide + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos, ypos-strhi); + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title); + end; + + BlankFrm.Image1.Canvas.Font.Color := clBlack; +end; + +procedure TMultXvsYFrm.UpdateBtnStates; +var + lSelected: Boolean; + i: Integer; +begin + lSelected := false; + for i:=0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + + XInBtn.Enabled := lSelected and (XEdit.Text = ''); + YInBtn.Enabled := lSelected and (YEdit.Text = ''); + GroupInBtn.Enabled := lSelected and (GroupEdit.Text = ''); + XOutBtn.Enabled := (XEdit.Text <> ''); + YOutBtn.Enabled := (YEdit.Text <> ''); + GroupOutBtn.Enabled := (GroupEdit.Text <> ''); +end; + +initialization + {$I multxvsyunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/normalityunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/normalityunit.lfm new file mode 100644 index 000000000..2fb9153b5 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/normalityunit.lfm @@ -0,0 +1,415 @@ +object NormalityFrm: TNormalityFrm + Left = 721 + Height = 396 + Top = 294 + Width = 402 + Caption = 'Normality Tests' + ClientHeight = 396 + ClientWidth = 402 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 49 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = TestVarEdit + AnchorSideBottom.Control = VarInBtn + AnchorSideBottom.Side = asrBottom + Left = 261 + Height = 15 + Top = 36 + Width = 93 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Test Normality of:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = VarInBtn + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 313 + Top = 25 + Width = 209 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object VarInBtn: TBitBtn + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = VarList + AnchorSideRight.Control = VarList + AnchorSideRight.Side = asrBottom + Left = 225 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = VarInBtnClick + Spacing = 0 + TabOrder = 1 + end + object VarOutBtn: TBitBtn + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = VarInBtn + AnchorSideTop.Side = asrBottom + Left = 225 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = VarOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object TestVarEdit: TEdit + AnchorSideLeft.Control = VarOutBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 261 + Height = 23 + Top = 53 + Width = 133 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 3 + Text = 'TestVarEdit' + end + object GroupBox1: TGroupBox + AnchorSideTop.Control = VarOutBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 225 + Height = 80 + Top = 97 + Width = 169 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + Caption = 'Shapiro-Wilkes Rresults' + ClientHeight = 60 + ClientWidth = 165 + TabOrder = 4 + object Label3: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = WEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 6 + Width = 33 + BorderSpacing.Left = 12 + Caption = 'WWW' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = ProbEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 33 + Width = 57 + BorderSpacing.Left = 12 + Caption = 'Probability' + ParentColor = False + end + object WEdit: TEdit + AnchorSideLeft.Control = ProbEdit + AnchorSideTop.Control = GroupBox1 + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 77 + Height = 23 + Top = 2 + Width = 80 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 0 + Text = 'WEdit' + end + object ProbEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = WEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 77 + Height = 23 + Top = 29 + Width = 80 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ReadOnly = True + TabOrder = 1 + Text = 'ProbEdit' + end + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 225 + Height = 155 + Top = 191 + Width = 169 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Lilliefors Test Results' + ClientHeight = 135 + ClientWidth = 165 + TabOrder = 5 + object Label5: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = SkewEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 6 + Width = 53 + BorderSpacing.Left = 12 + Caption = 'Skewness:' + ParentColor = False + end + object Label6: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = KurtosisEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 33 + Width = 45 + BorderSpacing.Left = 12 + Caption = 'Kurtosis:' + ParentColor = False + end + object Label7: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = StatEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 60 + Width = 67 + BorderSpacing.Left = 12 + Caption = 'Test Statistic:' + ParentColor = False + end + object SkewEdit: TEdit + AnchorSideLeft.Control = StatEdit + AnchorSideTop.Control = GroupBox2 + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 87 + Height = 23 + Top = 2 + Width = 70 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 0 + Text = 'SkewEdit' + end + object KurtosisEdit: TEdit + AnchorSideLeft.Control = StatEdit + AnchorSideTop.Control = SkewEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 87 + Height = 23 + Top = 29 + Width = 70 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 1 + Text = 'KurtosisEdit' + end + object StatEdit: TEdit + AnchorSideLeft.Control = Label7 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = KurtosisEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 87 + Height = 23 + Top = 56 + Width = 70 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ReadOnly = True + TabOrder = 2 + Text = 'StatEdit' + end + object Label8: TLabel + AnchorSideLeft.Control = Label5 + AnchorSideTop.Control = StatEdit + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 15 + Top = 87 + Width = 104 + Caption = 'Lillifors Conclusion:' + ParentColor = False + WordWrap = True + end + object ConclusionEdit: TEdit + AnchorSideLeft.Control = Label8 + AnchorSideTop.Control = Label8 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 12 + Height = 23 + Top = 104 + Width = 145 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ReadOnly = True + TabOrder = 3 + Text = 'ConclusionEdit' + end + end + object Panel1: TPanel + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 26 + Top = 362 + Width = 386 + Align = alBottom + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 26 + ClientWidth = 386 + TabOrder = 6 + object CloseBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 319 + Height = 25 + Top = 1 + Width = 55 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'Close' + ModalResult = 11 + TabOrder = 3 + end + object ApplyBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = CloseBtn + Left = 254 + Height = 25 + Top = 1 + Width = 57 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Apply' + OnClick = ApplyBtnClick + TabOrder = 2 + end + object PrintBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ApplyBtn + Left = 195 + Height = 25 + Top = 1 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Print' + OnClick = PrintBtnClick + TabOrder = 1 + end + object ResetBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = PrintBtn + Left = 133 + Height = 25 + Top = 1 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Right = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 0 + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + Left = 0 + Height = 8 + Top = 346 + Width = 402 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/normalityunit.pas b/applications/lazstats/source/forms/analysis/descriptive/normalityunit.pas new file mode 100644 index 000000000..d0986969f --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/normalityunit.pas @@ -0,0 +1,385 @@ +// Use file "cansas.laz" for testing + +unit NormalityUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, FunctionsLib, DataProcs, OutputUnit; + + +type + + { TNormalityFrm } + + TNormalityFrm = class(TForm) + Bevel1: TBevel; + ResetBtn: TButton; + PrintBtn: TButton; + ApplyBtn: TButton; + CloseBtn: TButton; + ConclusionEdit: TEdit; + Label8: TLabel; + Panel1: TPanel; + StatEdit: TEdit; + KurtosisEdit: TEdit; + SkewEdit: TEdit; + GroupBox2: TGroupBox; + Label5: TLabel; + Label6: TLabel; + Label7: TLabel; + ProbEdit: TEdit; + Label4: TLabel; + WEdit: TEdit; + GroupBox1: TGroupBox; + Label3: TLabel; + TestVarEdit: TEdit; + Label2: TLabel; + VarInBtn: TBitBtn; + VarOutBtn: TBitBtn; + Label1: TLabel; + VarList: TListBox; + procedure ApplyBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure PrintBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarInBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + procedure VarOutBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: boolean; + function Norm(z : double) : double; + procedure UpdateBtnStates; + + public + { public declarations } + end; + +var + NormalityFrm: TNormalityFrm; + +implementation + +uses + Math; + +{ TNormalityFrm } + +procedure TNormalityFrm.PrintBtnClick(Sender: TObject); +var + lReport: TStrings; +begin + lReport := TStringList.Create; + try + lReport.Add('NORMALITY TESTS FOR '+ TestVarEdit.Text); + lReport.Add(''); + lReport.Add('Shapiro-Wilkes W = ' + WEdit.Text); + lReport.Add('Shapiro-Wilkes Prob. = ' + ProbEdit.Text); + lReport.Add(''); + lReport.Add('Skew = ' + SkewEdit.Text); + lReport.Add('Kurtosis = ' + KurtosisEdit.Text); + lReport.Add('Lilliefors Test Statistic = ' + StatEdit.Text); + lReport.Add('Conclusion: ' + ConclusionEdit.Text); + + DisplayReport(lReport); + finally + lReport.Free; + end; +end; + +procedure TNormalityFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + TestVarEdit.Text := ''; + WEdit.Text := ''; + ProbEdit.Text := ''; + ConclusionEdit.Text := ''; + SkewEdit.Text := ''; + KurtosisEdit.Text := ''; + StatEdit.Text := ''; + VarList.Items.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TNormalityFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, PrintBtn.Width, ApplyBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + PrintBtn.Constraints.MinWidth := w; + ApplyBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + FAutoSized := True; +end; + +procedure TNormalityFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TNormalityFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(nil); +end; + +procedure TNormalityFrm.ApplyBtnClick(Sender: TObject); +var + w: Double = 0.0; + temp, pw : double; + skew, kurtosis : double; + mean, variance, stddev, deviation, devsqr, M2, M3, M4 : double; + i, j, n, n1, n2, ier : integer; + varlabel : string; + selcol : integer; + data, a, z, x : DblDyneVec; + freq : IntDyneVec; + fval, jval, DP : DblDyneVec; + F1, DPP, D, D1, A0, C1, D15, D10, D05, D025, t2 : double; + init : boolean; + msg : string; + + procedure Cleanup; + begin + DP := nil; + jval := nil; + fval := nil; + data := nil; + a := nil; + freq := nil; + z := nil; + x := nil; + end; + +begin + selcol := 0; + for i := 1 to NoVariables do + if OS3MainFrm.DataGrid.Cells[i,0] = TestVarEdit.Text then + begin + selcol := i; + break; + end; + if selCol = 0 then + begin + MessageDlg('No variable selected.', mtError, [mbOK], 0); + exit; + end; + + init := false; + n := 0; + varlabel := TestVarEdit.Text; + + // place values into the data array + SetLength(data, NoCases+1); // arrays start at 1 + SetLength(a, NoCases+1); + SetLength(freq, NoCases+1); + SetLength(z, NoCases+1); + SetLength(x, NoCases+1); + SetLength(fval, NoCases+1); + SetLength(jval, NoCases+1); + SetLength(DP, NoCases+1); + for i := 1 to NoCases do + begin + if not ValidValue(i,selcol) then + continue; + n := n + 1; + data[n] := StrToFloat(OS3MainFrm.DataGrid.Cells[selcol,i]); + end; + n1 := n; + n2 := n div 2; + + // sort into ascending order + for i := 1 to n - 1 do + begin + for j := i + 1 to n do + begin + if data[i] > data[j] then + begin + temp := data[i]; + data[i] := data[j]; + data[j] := temp; + end; + end; + end; + + // call Shapiro-Wilks function + swilk(init, data, n, n1, n2, a, w, pw, ier); + if ier <> 0 then + begin + msg := 'Error encountered = ' + IntToStr(ier); + MessageDlg(msg, mtError, [mbOK], 0); + Cleanup; + exit; + end; + WEdit.Text := Format('%8.4f', [w]); + ProbEdit.Text := Format('%8.4f', [pw]); + + // Now do Lilliefors + // Get unique scores and their frequencies + n1 := 1; + i := 1; + freq[1] := 1; + x[1] := data[1]; + repeat +//again: + for j := i + 1 to n do + begin + if data[j] = x[n1] then freq[n1] := freq[n1] + 1; + end; + i := i + freq[n1]; + if i <= n then + begin + n1 := n1 + 1; + x[n1] := data[i]; + freq[n1] := 1; + //goto again; + end; + until i > n; + + // now get skew and kurtosis of scores + mean := 0.0; + variance := 0.0; + for i := 1 to n do + begin + mean := mean + data[i]; + variance := variance + (data[i] * data[i]); + end; + variance := variance - (mean * mean) / n; + variance := variance / (n - 1); + stddev := sqrt(variance); + mean := mean / n; + + // obtain skew, kurtosis and z scores + M2 := 0.0; + M3 := 0.0; + M4 := 0.0; + for i := 1 to n do + begin + deviation := data[i] - mean; + devsqr := deviation * deviation; + M2 := M2 + devsqr; + M3 := M3 + (deviation * devsqr); + M4 := M4 + (devsqr * devsqr); + z[i] := (data[i] - mean) / stddev; + end; + for i := 1 to n1 do x[i] := (x[i] - mean) / stddev; + skew := (n * M3) / ((n - 1) * (n - 2) * stddev * variance); + kurtosis := (n * (n + 1) * M4) - (3 * M2 * M2 * (n - 1)); + kurtosis := kurtosis /( (n - 1) * (n - 2) * (n - 3) * (variance * variance) ); + SkewEdit.Text := Format('%8.3f', [skew]); + KurtosisEdit.Text := Format('%8.3f', [kurtosis]); + + // obtain the test statistic + for i := 1 to n1 do + begin + F1 := Norm(x[i]); + if x[i] >= 0 then + fval[i] := 1.0 - (F1 / 2.0) + else + fval[i] := F1 / 2.0; + end; + + // cumulative proportions + jval[1] := freq[1] / n; + for i := 2 to n1 do jval[i] := jval[i-1] + freq[i] / n; + for i := 1 to n1 do DP[i] := abs(jval[i] - fval[i]); + + // sort DP + for i := 1 to n1-1 do + begin + for j := i+1 to n1 do + begin + if DP[j] < DP[i] then + begin + temp := DP[i]; + DP[i] := DP[j]; + DP[j] := temp; + end; + end; + end; + DPP := DP[n1]; + D := DPP; + D1 := D; + StatEdit.Text := Format('%8.3f', [D]); + A0 := sqrt(n); + C1 := A0 - 0.01 + (0.85 / A0); + D15 := 0.775 / C1; + D10 := 0.819 / C1; + D05 := 0.895 / C1; + D025 := 0.995 / C1; + t2 := D; + if t2 > D025 then ConclusionEdit.Text := 'Strong evidence against normality.'; + if ((t2 <= D025) and (t2 > D05)) then ConclusionEdit.Text := 'Sufficient evidence against normality.'; + if ((t2 <= D05) and (t2 > D10)) then ConclusionEdit.Text := 'Suggestive evidence against normality.'; + if ((t2 <= D10) and (t2 > D15)) then ConclusionEdit.Text := 'Little evidence against normality.'; + if (t2 <= D15) then ConclusionEdit.Text := 'No evidence against normality.'; + + Cleanup; +end; + +procedure TNormalityFrm.VarInBtnClick(Sender: TObject); +var + i: integer; +begin + i := VarList.ItemIndex; + if (i > -1) and (TestVarEdit.Text = '') then + begin + TestVarEdit.Text := VarList.Items.Strings[i]; + VarList.Items.Delete(i); + end; + UpdateBtnStates; +end; + +procedure TNormalityFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TNormalityFrm.VarOutBtnClick(Sender: TObject); +begin + if TestVarEdit.Text <> '' then + begin + VarList.Items.Add(TestVarEdit.Text); + TestVarEdit.Text := ''; + end; + UpdateBtnStates; +end; + +function TNormalityFrm.Norm(z : double) : double; +var + p : double; +begin + z := abs(z); + p := 1.0 + z * (0.04986735 + z * (0.02114101 + z * (0.00327763 + + z * (0.0000380036 + z * (0.0000488906 + z * 0.000005383))))); + p := p * p; + p := p * p; + p := p * p; + Result := 1.0 / (p * p); +end; + +procedure TNormalityFrm.UpdateBtnStates; +begin + VarInBtn.Enabled := (VarList.ItemIndex > -1) and (TestVarEdit.Text = ''); + VarOutBtn.Enabled := (TestVarEdit.Text <> ''); +end; + +initialization + {$I normalityunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/plotxyunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/plotxyunit.lfm new file mode 100644 index 000000000..c56c4762e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/plotxyunit.lfm @@ -0,0 +1,337 @@ +object PlotXYFrm: TPlotXYFrm + Left = 433 + Height = 367 + Top = 262 + Width = 490 + AutoSize = True + Caption = 'Plot X versus Y' + ClientHeight = 367 + ClientWidth = 490 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 46 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = XEdit + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = XEdit + Left = 267 + Height = 15 + Top = 31 + Width = 76 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'X Axis Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = YEdit + AnchorSideBottom.Control = YEdit + Left = 267 + Height = 15 + Top = 117 + Width = 76 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Y Axis Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = XinBtn + AnchorSideBottom.Control = Bevel1 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 293 + Top = 25 + Width = 215 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object XinBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + AnchorSideRight.Control = XEdit + Left = 231 + Height = 28 + Top = 25 + Width = 28 + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = XinBtnClick + Spacing = 0 + TabOrder = 1 + end + object XOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = XinBtn + AnchorSideTop.Side = asrBottom + Left = 231 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = XOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object YInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = XOutBtn + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = YOutBtn + Left = 231 + Height = 28 + Top = 109 + Width = 28 + BorderSpacing.Top = 24 + BorderSpacing.Bottom = 4 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = YInBtnClick + Spacing = 0 + TabOrder = 3 + end + object YOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = YInBtn + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 231 + Height = 28 + Top = 141 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = YOutBtnClick + Spacing = 0 + TabOrder = 4 + end + object XEdit: TEdit + AnchorSideLeft.Control = XinBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = XOutBtn + AnchorSideBottom.Side = asrBottom + Left = 267 + Height = 23 + Top = 50 + Width = 215 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 5 + Text = 'XEdit' + end + object YEdit: TEdit + AnchorSideLeft.Control = XEdit + AnchorSideRight.Control = XEdit + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = YOutBtn + AnchorSideBottom.Side = asrBottom + Left = 267 + Height = 23 + Top = 134 + Width = 215 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'YEdit' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = YEdit + AnchorSideTop.Control = YEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 267 + Height = 141 + Top = 181 + Width = 191 + AutoSize = True + BorderSpacing.Top = 24 + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ClientHeight = 121 + ClientWidth = 187 + TabOrder = 7 + object Label4: TLabel + AnchorSideLeft.Control = ConfChk + AnchorSideTop.Control = ConfEdit + AnchorSideTop.Side = asrCenter + Left = 36 + Height = 15 + Top = 94 + Width = 74 + BorderSpacing.Left = 24 + BorderSpacing.Right = 8 + Caption = '% Confidence' + ParentColor = False + end + object DescChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + Left = 12 + Height = 19 + Top = 2 + Width = 155 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Caption = 'Print Descriptive Statistics' + TabOrder = 0 + end + object ConfEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ConfChk + AnchorSideTop.Side = asrBottom + Left = 118 + Height = 23 + Top = 90 + Width = 57 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + TabOrder = 1 + Text = '95.0' + end + object LineChk: TCheckBox + AnchorSideLeft.Control = DescChk + AnchorSideTop.Control = DescChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 25 + Width = 146 + BorderSpacing.Top = 4 + Caption = 'Plot the Regression Line' + TabOrder = 2 + end + object MeansChk: TCheckBox + AnchorSideLeft.Control = LineChk + AnchorSideTop.Control = LineChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 48 + Width = 99 + BorderSpacing.Top = 4 + Caption = 'Plot the Means' + TabOrder = 3 + end + object ConfChk: TCheckBox + AnchorSideLeft.Control = MeansChk + AnchorSideTop.Control = MeansChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 71 + Width = 155 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + Caption = 'Plot the Confidence Band' + TabOrder = 4 + end + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 416 + Height = 25 + Top = 334 + Width = 62 + Anchors = [akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 8 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 332 + Height = 25 + Top = 334 + Width = 76 + Anchors = [akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 9 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 270 + Height = 25 + Top = 334 + Width = 54 + Anchors = [akRight, akBottom] + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 10 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 318 + Width = 490 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/plotxyunit.pas b/applications/lazstats/source/forms/analysis/descriptive/plotxyunit.pas new file mode 100644 index 000000000..0c67a8116 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/plotxyunit.pas @@ -0,0 +1,774 @@ +// Use file "cansas.laz" for testing + +unit PlotXYUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, + MainUnit, Globals, OutputUnit, FunctionsLib, DataProcs, BlankFrmUnit; + +type + + { TPlotXYFrm } + + TPlotXYFrm = class(TForm) + Bevel1: TBevel; + ConfEdit: TEdit; + Label4: TLabel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + DescChk: TCheckBox; + LineChk: TCheckBox; + MeansChk: TCheckBox; + ConfChk: TCheckBox; + GroupBox1: TGroupBox; + YEdit: TEdit; + Label3: TLabel; + XEdit: TEdit; + Label2: TLabel; + XinBtn: TBitBtn; + XOutBtn: TBitBtn; + YInBtn: TBitBtn; + YOutBtn: TBitBtn; + Label1: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + procedure XinBtnClick(Sender: TObject); + procedure XOutBtnClick(Sender: TObject); + procedure YInBtnClick(Sender: TObject); + procedure YOutBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure plotxy(VAR Xpoints : DblDyneVec; + VAR Ypoints : DblDyneVec; + VAR UpConf : DblDyneVec; + VAR LowConf : DblDyneVec; + ConfBand : double; + Xmean, Ymean , R : double; + Slope, Intercept : double; + Xmax, Xmin, Ymax, Ymin : double; + N : integer); + + { + procedure pplotxy(VAR Xpoints : DblDyneVec; + VAR Ypoints : DblDyneVec; + VAR UpConf : DblDyneVec; + VAR LowConf : DblDyneVec; + ConfBand : double; + Xmean, Ymean , R : double; + Slope, Intercept : double; + Xmax, Xmin, Ymax, Ymin : double; + N : integer); + } + procedure UpdateBtnStates; + + function Validate(out AMsg: String; out AControl: TWinControl; + Xcol,Ycol: Integer): Boolean; + public + { public declarations } + end; + +var + PlotXYFrm: TPlotXYFrm; + +implementation + +uses + Math; + +{ TPlotXYFrm } + +procedure TPlotXYFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + XEdit.Text := ''; + YEdit.Text := ''; + ConfEdit.Text := FormatFloat('0.0', DEFAULT_CONFIDENCE_LEVEL_PERCENT); + DescChk.Checked := false; + LineChk.Checked := false; + MeansChk.Checked := false; + ConfChk.Checked := false; + //PrintChk.Checked := false; + VarList.Items.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TPlotXYFrm.XinBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if index > -1 then + begin + XEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TPlotXYFrm.XOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(XEdit.Text); + XEdit.Text := ''; + UpdateBtnStates; +end; + +procedure TPlotXYFrm.YInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if index > -1 then + begin + YEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TPlotXYFrm.YOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(YEdit.Text); + YEdit.Text := ''; + UpdateBtnStates; +end; + +procedure TPlotXYFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TPlotXYFrm.ComputeBtnClick(Sender: TObject); +var + Xmin, Xmax, Ymin, Ymax, SSx, t, DF : double; + Xmean, Ymean, Xvariance, Yvariance, Xstddev, Ystddev, ConfBand : double; + X, Y, R, temp, SEPred, Slope, Intercept, predicted, sedata : double; + i, j : integer; + Xcol, Ycol, N, NoSelected : integer; + Xpoints : DblDyneVec; + Ypoints : DblDyneVec; + UpConf : DblDyneVec; + lowConf : DblDyneVec; + cellstring : string; + ColNoSelected : IntDyneVec; + C: TWinControl; + msg: String; + lReport: TStrings; +begin + SetLength(Xpoints,NoCases + 1); + SetLength(Ypoints,NoCases + 1); + SetLength(UpConf,NoCases + 1); + SetLength(lowConf,NoCases + 1); + SetLength(ColNoSelected,NoVariables); + + Xcol := 0; + Ycol := 0; + + for i := 1 to Novariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = XEdit.Text then Xcol := i; + if cellstring = YEdit.Text then Ycol := i; + end; + + // Validation + if not Validate(msg, C, Xcol, Ycol) then + begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + ModalResult := mrNone; + exit; + end; + + NoSelected := 2; + ColNoSelected[0] := Xcol; + ColNoSelected[1] := Ycol; + N := 0; + Xmax := -1.0e20; + Xmin := 1.0e20; + Ymax := -1.0e20; + Ymin := 1.0e20; + Xmean := 0.0; + Ymean := 0.0; + Xvariance := 0.0; + Yvariance := 0.0; + R := 0.0; + + for i := 1 to NoCases do + begin + if Not GoodRecord(i,NoSelected,ColNoSelected) then continue; + N := N + 1; + X := StrToFloat(OS3MainFrm.DataGrid.Cells[Xcol,i]); + Y := StrToFloat(OS3MainFrm.DataGrid.Cells[Ycol,i]); + Xpoints[N] := X; + Ypoints[N] := Y; + if X > Xmax then Xmax := X; + if X < Xmin then Xmin := X; + if Y > Ymax then Ymax := Y; + if Y < Ymin then Ymin := Y; + Xmean := Xmean + X; + Ymean := Ymean + Y; + Xvariance := Xvariance + (X * X); + Yvariance := Yvariance + (Y * Y); + R := R + (X * Y); + end; + + // sort on X + for i := 1 to N - 1 do + begin + for j := i + 1 to N do + begin + if Xpoints[i] > Xpoints[j] then //swap + begin + temp := Xpoints[i]; + Xpoints[i] := Xpoints[j]; + Xpoints[j] := temp; + temp := Ypoints[i]; + Ypoints[i] := Ypoints[j]; + Ypoints[j] := temp; + end; + end; + end; + + // calculate statistics + Xvariance := Xvariance - (Xmean * Xmean / N); + SSx := Xvariance; + Xvariance := Xvariance / (N - 1); + Xstddev := sqrt(Xvariance); + + Yvariance := Yvariance - (Ymean * Ymean / N); + Yvariance := Yvariance / (N - 1); + Ystddev := sqrt(Yvariance); + + R := R - (Xmean * Ymean / N); + R := R / (N - 1); + R := R / (Xstddev * Ystddev); + SEPred := sqrt(1.0 - (R * R)) * Ystddev; + SEPred := SEPred * sqrt((N - 1) / (N - 2)); + Xmean := Xmean / N; + Ymean := Ymean / N; + Slope := R * Ystddev / Xstddev; + Intercept := Ymean - Slope * Xmean; + + // Now, print the descriptive statistics to the output form if requested + if DescChk.Checked then + begin + lReport := TStringList.Create; + try + lReport.Add('X vs. Y PLOT'); + lReport.Add(''); + lReport.Add('X = %s, Y = %s from file: %s',[Xedit.Text, YEdit.Text,OS3MainFrm.FileNameEdit.Text]); + lReport.Add(''); + lReport.Add('Variable Mean Variance Std.Dev.'); + lReport.Add('%-10s%8.2f %8.2f %8.2f', [XEdit.Text,Xmean,Xvariance,Xstddev]); + lReport.Add('%-10s%8.2f %8.2f %8.2f', [YEdit.Text,Ymean,Yvariance,Ystddev]); + lReport.Add(''); + lReport.Add('Correlation: %8.3f', [R]); + lReport.Add('Slope: %8.3f', [Slope]); + lReport.Add('Intercept: %8.3f', [Intercept]); + lReport.Add('Standard Error of Estimate: %8.3f', [SEPred]); + lReport.Add('Number of good cases: %8d', [N]); + + DisplayReport(lReport); + finally + lReport.Free; + end; + end; + + // get upper and lower confidence points for each X value + if ConfChk.Checked then + begin + ConfBand := StrToFloat(ConfEdit.Text) / 100.0; + DF := N - 2; + t := inverset(ConfBand,DF); + for i := 1 to N do + begin + X := Xpoints[i]; + predicted := slope * X + intercept; + sedata := SEPred * sqrt(1.0 + (1.0 / N) + (sqr(X - Xmean) / SSx)); + UpConf[i] := predicted + (t * sedata); + lowConf[i] := predicted - (t * sedata); + if UpConf[i] > Ymax then Ymax := UpConf[i]; + if lowConf[i] < Ymin then Ymin := lowConf[i]; + end; + end + else ConfBand := 0.0; + + // plot the values (and optional line and confidence band if elected) + plotxy(Xpoints, Ypoints, UpConf, LowConf, ConfBand, Xmean, Ymean, R, + Slope, Intercept, Xmax, Xmin, Ymax, Ymin, N); + Application.ProcessMessages; + + { + // print the same if elected + if PrintChk.Checked then + pplotxy(Xpoints, Ypoints, UpConf, LowConf, ConfBand, Xmean, Ymean, + R, Slope, Intercept, Xmax, Xmin, Ymax, Ymin, N); + } + + // cleanup + ColNoSelected := nil; + lowConf := nil; + UpConf := nil; + Ypoints := nil; + Xpoints := nil; +end; + +procedure TPlotXYFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinHeight := GroupBox1.Top + GroupBox1.Height - VarList.Top; + VarList.Constraints.MinWidth := GroupBox1.Width; + + Constraints.MinWidth := GroupBox1.Width * 2 + XInBtn.Width + 4 * VarList.BorderSpacing.Left; + Constraints.MinHeight := Height; + + FAutoSized := True; +end; + +procedure TPlotXYFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if BlankFrm = nil then Application.CreateForm(TBlankFrm, BlankFrm); +end; + +procedure TPlotXYFrm.plotxy(VAR Xpoints : DblDyneVec; + VAR Ypoints : DblDyneVec; + VAR UpConf : DblDyneVec; + VAR LowConf : DblDyneVec; + ConfBand : double; + Xmean, Ymean , R : double; + Slope, Intercept : double; + Xmax, Xmin, Ymax, Ymin : double; + N : integer); +var + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; + vhi, hwide, offset, strhi, imagehi : integer; + valincr, Yvalue, Xvalue : double; + Title : string; + +begin + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Show; + Title := 'X versus Y PLOT Using File: ' + OS3MainFrm.FileNameEdit.Text; + BlankFrm.Caption := Title; + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + vtop := 20; + vbottom := round(imagehi) - 80; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + + // Draw chart border + BlankFrm.Image1.Canvas.Rectangle(0,0,imagewide,imagehi); + + // draw Means + if MeansChk.Checked then + begin + ypos := round(vhi * ( (Ymax - Ymean) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clGreen; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'MEAN '; + Title := Title + YEdit.Text; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + xpos := round(hwide * ( (Xmean - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + ypos := vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := vbottom; + BlankFrm.Image1.Canvas.Pen.Color := clGreen; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'MEAN '; + Title := Title + XEdit.Text; + strhi := BlankFrm.Image1.Canvas.TextWidth(Title); + xpos := xpos - strhi div 2; + ypos := vtop - BlankFrm.Image1.Canvas.TextHeight(Title); + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + + // draw slope line + if LineChk.Checked then + begin + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + Yvalue := (Xpoints[1] * slope) + intercept; // predicted score + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[1]- Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + Yvalue := (Xpoints[N] * slope) + intercept; // predicted score + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[N] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // draw horizontal axis + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom); + valincr := (Xmax - Xmin) / 10.0; + for i := 1 to 11 do + begin + ypos := vbottom; + Xvalue := Xmin + valincr * (i - 1); + xpos := round(hwide * ((Xvalue - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := format('%6.2f',[Xvalue]); + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + xpos := xpos - offset; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(XEdit.Text) div 2); + ypos := vbottom + 20; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,XEdit.Text); + Title := format('R(X,Y) = %5.3f, Slope = %6.2f, Intercept = %6.2f', + [R,Slope,Intercept]); + xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(Title) div 2); + ypos := ypos + 15; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + // Draw vertical axis + Title := YEdit.Text; + xpos := hleft - BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + ypos := vtop - BlankFrm.Image1.Canvas.TextHeight(Title); + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,YEdit.Text); + xpos := hleft; + ypos := vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := vbottom; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + valincr := (Ymax - Ymin) / 10.0; + for i := 1 to 11 do + begin + Title := format('%8.2f',[Ymax - ((i-1)*valincr)]); + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := 10; + Yvalue := Ymax - (valincr * (i-1)); + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + xpos := hleft; + ypos := ypos + strhi div 2; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hleft - 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // draw points for x and y pairs + for i := 1 to N do + begin + ypos := round(vhi * ( (Ymax - Ypoints[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.Brush.Color := clNavy; + BlankFrm.Image1.Canvas.Brush.Style := bsSolid; + BlankFrm.Image1.Canvas.Pen.Color := clNavy; + BlankFrm.Image1.Canvas.Ellipse(xpos,ypos,xpos+5,ypos+5); + end; + + // draw confidence bands if requested + if ConfBand <> 0.0 then + begin + BlankFrm.Image1.Canvas.Pen.Color := clRed; + ypos := round(vhi * ((Ymax - UpConf[1]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[1] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + for i := 2 to N do + begin + ypos := round(vhi * ((Ymax - UpConf[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + ypos := round(vhi * ((Ymax - lowConf[1]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[1] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + for i := 2 to N do + begin + ypos := round(vhi * ((Ymax - lowConf[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + end; +end; +//------------------------------------------------------------------- +(* +procedure TPlotXYFrm.pplotxy(VAR Xpoints : DblDyneVec; + VAR Ypoints : DblDyneVec; + VAR UpConf : DblDyneVec; + VAR LowConf : DblDyneVec; + ConfBand : double; + Xmean, Ymean , R : double; + Slope, Intercept : double; + Xmax, Xmin, Ymax, Ymin : double; + N : integer); +var + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; + vhi, hwide, offset, strhi : integer; + imagehi, maxval, minval, valincr, Yvalue, Xvalue : double; + Title : string; + +begin + if not PrintDialog.Execute then + exit; + + Printer.Orientation := poLandscape; + Printer.BeginDoc; + Title := 'X versus Y PLOT Using File: ' + OS3MainFrm.FileNameEdit.Text; + strhi := Printer.Canvas.TextWidth(Title) div 2; + Printer.Canvas.TextOut(strhi,5,Title); + imagewide := Printer.PageWidth - 100; + imagehi := Printer.PageHeight - 100; + vtop := 120; + vbottom := round(imagehi) - 100; + vhi := vbottom - vtop; + hleft := 300; + hright := imagewide - 200; + hwide := hright - hleft; + Printer.Canvas.Pen.Color := clBlack; + Printer.Canvas.Brush.Color := clWhite; + + // draw Means + if MeansChk.Checked then + begin + ypos := round(vhi * ( (Ymax - Ymean) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := hleft; + Printer.Canvas.MoveTo(xpos,ypos); + xpos := hright; + Printer.Canvas.Pen.Color := clGreen; + Printer.Canvas.LineTo(xpos,ypos); + Title := 'MEAN '; + Title := Title + YEdit.Text; + strhi := Printer.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + Printer.Canvas.Brush.Color := clWhite; + Printer.Canvas.TextOut(xpos,ypos,Title); + + xpos := round(hwide * ( (Xmean - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + ypos := vtop; + Printer.Canvas.MoveTo(xpos,ypos); + ypos := vbottom; + Printer.Canvas.Pen.Color := clGreen; + Printer.Canvas.LineTo(xpos,ypos); + Title := 'MEAN '; + Title := Title + XEdit.Text; + strhi := Printer.Canvas.TextWidth(Title); + xpos := xpos - strhi div 2; + ypos := vtop - Printer.Canvas.TextHeight(Title); + Printer.Canvas.Brush.Color := clWhite; + Printer.Canvas.TextOut(xpos,ypos,Title); + end; + + // draw slope line + if LineChk.Checked then + begin + Printer.Canvas.Pen.Color := clBlack; + Yvalue := (Xpoints[1] * slope) + intercept; // predicted score + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[1]- Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + Printer.Canvas.MoveTo(xpos,ypos); + Yvalue := (Xpoints[N] * slope) + intercept; // predicted score + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[N] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + Printer.Canvas.LineTo(xpos,ypos); + end; + + // draw horizontal axis + Printer.Canvas.Pen.Color := clBlack; + Printer.Canvas.MoveTo(hleft,vbottom); + Printer.Canvas.LineTo(hright,vbottom); + valincr := (Xmax - Xmin) / 10.0; + for i := 1 to 11 do + begin + ypos := vbottom; + Xvalue := Xmin + valincr * (i - 1); + xpos := round(hwide * ((Xvalue - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + Printer.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + Printer.Canvas.LineTo(xpos,ypos); + Title := format('%6.2f',[Xvalue]); + offset := Printer.Canvas.TextWidth(Title) div 2; + xpos := xpos - offset; + Printer.Canvas.Pen.Color := clBlack; + Printer.Canvas.TextOut(xpos,ypos,Title); + end; + xpos := hleft + (hwide div 2) - (Printer.Canvas.TextWidth(XEdit.Text) div 2); + ypos := vbottom + 40; + Printer.Canvas.TextOut(xpos,ypos,XEdit.Text); + Title := format('R(X,Y) = %5.3f, Slope = %6.2f, Intercept = %6.2f', + [R,Slope,Intercept]); + xpos := hleft + (hwide div 2) - (Printer.Canvas.TextWidth(Title) div 2); + ypos := ypos + 40; + Printer.Canvas.TextOut(xpos,ypos,Title); + + // Draw vertical axis + Title := YEdit.Text; + xpos := hleft - Printer.Canvas.TextWidth(Title) div 2; + ypos := vtop - Printer.Canvas.TextHeight(Title); + Printer.Canvas.TextOut(xpos,ypos,YEdit.Text); + xpos := hleft; + ypos := vtop; + Printer.Canvas.MoveTo(xpos,ypos); + ypos := vbottom; + Printer.Canvas.LineTo(xpos,ypos); + valincr := (Ymax - Ymin) / 10.0; + for i := 1 to 11 do + begin + Title := format('%8.2f',[Ymax - ((i-1)*valincr)]); + strhi := Printer.Canvas.TextHeight(Title); + xpos := 10; + Yvalue := Ymax - (valincr * (i-1)); + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop - strhi div 2; + Printer.Canvas.TextOut(xpos,ypos,Title); + xpos := hleft; + ypos := ypos + strhi div 2; + Printer.Canvas.MoveTo(xpos,ypos); + xpos := hleft - 10; + Printer.Canvas.LineTo(xpos,ypos); + end; + + // draw points for x and y pairs + for i := 1 to N do + begin + ypos := round(vhi * ( (Ymax - Ypoints[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + Printer.Canvas.Pen.Color := clBlack; + Printer.Canvas.Ellipse(xpos,ypos,xpos+15,ypos+15); + end; + + // draw confidence bands if requested + if ConfBand <> 0.0 then + begin + Printer.Canvas.Pen.Color := clRed; + ypos := round(vhi * ((Ymax - UpConf[1]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[1] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + Printer.Canvas.MoveTo(xpos,ypos); + for i := 2 to N do + begin + ypos := round(vhi * ((Ymax - UpConf[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + Printer.Canvas.LineTo(xpos,ypos); + end; + ypos := round(vhi * ((Ymax - lowConf[1]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[1] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + Printer.Canvas.MoveTo(xpos,ypos); + for i := 2 to N do + begin + ypos := round(vhi * ((Ymax - lowConf[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + Printer.Canvas.LineTo(xpos,ypos); + end; + end; + + Printer.EndDoc; + Printer.Orientation := poPortrait; +end; +//------------------------------------------------------------------- +*) +function TPlotXYFrm.Validate(out AMsg: String; out AControl: TWinControl; + Xcol, Ycol: Integer): Boolean; +begin + Result := false; + + if (Xcol = 0) then + begin + AControl := XEdit; + AMsg := 'No case selected for X.'; + exit; + end; + + if (Ycol = 0) then + begin + AControl := YEdit; + AMsg := 'No case selected for Y.'; + exit; + end; + Result := true; +end; + +procedure TPlotXYFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TPlotXYFrm.UpdateBtnStates; +begin + XinBtn.Enabled := (VarList.ItemIndex > -1) and (XEdit.Text = ''); + XoutBtn.Enabled := (XEdit.Text <> ''); + YinBtn.Enabled := (VarList.ItemIndex > -1) and (YEdit.Text = ''); + YoutBtn.Enabled := (YEdit.Text <> ''); +end; + +initialization + {$I plotxyunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/resistancelineunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/resistancelineunit.lfm new file mode 100644 index 000000000..9ba16eef9 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/resistancelineunit.lfm @@ -0,0 +1,568 @@ +object ResistanceLineForm: TResistanceLineForm + Left = 581 + Height = 480 + Top = 301 + Width = 535 + Caption = 'Resistant Line for Bivariate Data' + ClientHeight = 480 + ClientWidth = 535 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = HorCenterBevel + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 144 + Width = 46 + BorderSpacing.Left = 8 + Caption = 'Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = XEdit + AnchorSideTop.Control = Label1 + Left = 188 + Height = 15 + Top = 144 + Width = 93 + Caption = 'Selected Variables' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = XEdit + AnchorSideBottom.Control = XEdit + Left = 188 + Height = 15 + Top = 183 + Width = 51 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'X Variable' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = YEdit + AnchorSideBottom.Control = YEdit + Left = 188 + Height = 15 + Top = 300 + Width = 51 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Y Variable' + ParentColor = False + end + object XEdit: TEdit + AnchorSideLeft.Control = XInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideBottom.Control = XOutBtn + AnchorSideBottom.Side = asrBottom + Left = 188 + Height = 23 + Top = 200 + Width = 136 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Right = 16 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'XEdit' + end + object YEdit: TEdit + AnchorSideLeft.Control = XEdit + AnchorSideRight.Control = XEdit + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = YOutBtn + AnchorSideBottom.Side = asrBottom + Left = 188 + Height = 23 + Top = 317 + Width = 136 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'Edit1' + end + object XInBtn: TBitBtn + AnchorSideLeft.Control = HorCenterBevel + AnchorSideLeft.Side = asrCenter + AnchorSideRight.Control = XEdit + AnchorSideBottom.Control = XOutBtn + Left = 152 + Height = 28 + Top = 175 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = XInBtnClick + Spacing = 0 + TabOrder = 1 + end + object YInBtn: TBitBtn + AnchorSideLeft.Control = HorCenterBevel + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = YEdit + Left = 152 + Height = 28 + Top = 292 + Width = 28 + BorderSpacing.Right = 8 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = YInBtnClick + Spacing = 0 + TabOrder = 4 + end + object XOutBtn: TBitBtn + AnchorSideLeft.Control = XInBtn + AnchorSideBottom.Control = Bevel1 + Left = 152 + Height = 28 + Top = 207 + Width = 28 + Anchors = [akLeft, akBottom] + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = XOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object YOutBtn: TBitBtn + AnchorSideLeft.Control = YInBtn + AnchorSideTop.Control = YInBtn + AnchorSideTop.Side = asrBottom + Left = 152 + Height = 28 + Top = 324 + Width = 28 + BorderSpacing.Top = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = YOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 326 + Height = 25 + Top = 447 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 11 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 388 + Height = 25 + Top = 447 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 12 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 472 + Height = 25 + Top = 447 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 13 + end + object GroupBox1: TGroupBox + AnchorSideTop.Control = Label1 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 340 + Height = 152 + Top = 144 + Width = 187 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Options' + ClientHeight = 132 + ClientWidth = 183 + Enabled = False + TabOrder = 7 + object Label5: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = ConfEdit + AnchorSideTop.Side = asrCenter + Left = 32 + Height = 15 + Top = 101 + Width = 74 + BorderSpacing.Left = 32 + Caption = '% Confidence' + ParentColor = False + end + object DescChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = PointsChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 21 + Width = 155 + BorderSpacing.Left = 12 + Caption = 'Print Descriptive Statistics' + TabOrder = 1 + end + object ConfEdit: TEdit + AnchorSideLeft.Control = Label5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ConfChk + AnchorSideTop.Side = asrBottom + Left = 114 + Height = 23 + Top = 97 + Width = 57 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 12 + TabOrder = 5 + Text = '95.0' + end + object LineChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = DescChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 40 + Width = 146 + BorderSpacing.Left = 12 + Caption = 'Plot the Regression Line' + TabOrder = 2 + end + object MeansChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = LineChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 59 + Width = 99 + BorderSpacing.Left = 12 + Caption = 'Plot the Means' + TabOrder = 3 + end + object ConfChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = MeansChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 78 + Width = 155 + BorderSpacing.Left = 12 + Caption = 'Plot the Confidence Band' + TabOrder = 4 + end + object PointsChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + Left = 12 + Height = 19 + Top = 2 + Width = 153 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + Caption = 'Plot All of the points First' + TabOrder = 0 + end + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = XInBtn + AnchorSideBottom.Control = StdCorChk + Left = 8 + Height = 205 + Top = 161 + Width = 136 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object StdCorChk: TCheckBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = PlotMediansChk + Left = 8 + Height = 19 + Top = 374 + Width = 330 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + Caption = 'Option: Compute a standard product-moment correlation.' + OnChange = StdCorChkChange + TabOrder = 8 + end + object PlotMediansChk: TCheckBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = GridChk + Left = 8 + Height = 19 + Top = 393 + Width = 265 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + Caption = 'Plot the Three Medians and Slope Line (in Red)' + TabOrder = 9 + end + object GridChk: TCheckBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 19 + Top = 412 + Width = 248 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + Caption = 'Enter Predicted Y and Residual Y in the Grid' + TabOrder = 10 + end + object Bevel1: TBevel + AnchorSideLeft.Control = YInBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrCenter + Left = 161 + Height = 57 + Top = 235 + Width = 10 + Shape = bsSpacer + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 431 + Width = 535 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 120 + Top = 8 + Width = 519 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'The Resistant Line procedure creates three equal groups by sorting on the X variable and obtaining the median value of each group.'#13#10#13#10'The median values for these three groups on both the X and Y variables are then plotted. The line from the low group median to the middle group median is plotted as well as the line from the middle group to the top group median. A comparison of the slope of these two lines gives an indication of the degree to which the data fit a straight line. Enter the X and Y variables to be analyzed and click the compute button.' + ParentColor = False + WordWrap = True + end + object HorCenterBevel: TBevel + AnchorSideLeft.Control = VarList + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = XEdit + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 16 + Top = 128 + Width = 316 + Anchors = [akTop, akLeft, akRight] + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/resistancelineunit.pas b/applications/lazstats/source/forms/analysis/descriptive/resistancelineunit.pas new file mode 100644 index 000000000..2a218985e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/resistancelineunit.pas @@ -0,0 +1,747 @@ +// Use file "Sickness.laz" for testing + +unit ResistanceLineUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, Printers, + MainUnit, Globals, FunctionsLib, OutputUnit, DataProcs, DictionaryUnit, + ContextHelpUnit, BlankFrmUnit; + +type + + { TResistanceLineForm } + + TResistanceLineForm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + HorCenterBevel: TBevel; + GridChk: TCheckBox; + Memo1: TLabel; + PlotMediansChk: TCheckBox; + StdCorChk: TCheckBox; + PointsChk: TCheckBox; + ConfChk: TCheckBox; + ConfEdit: TEdit; + DescChk: TCheckBox; + GroupBox1: TGroupBox; + Label5: TLabel; + LineChk: TCheckBox; + VarList: TListBox; + MeansChk: TCheckBox; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + XInBtn: TBitBtn; + YInBtn: TBitBtn; + XOutBtn: TBitBtn; + YOutBtn: TBitBtn; + XEdit: TEdit; + YEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure StdCorChkChange(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + procedure XInBtnClick(Sender: TObject); + procedure XOutBtnClick(Sender: TObject); + procedure YInBtnClick(Sender: TObject); + procedure YOutBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + function Median(var X: DblDyneVec; ASize: integer): double; + procedure PlotXY(var Xpoints, YPoints, UpConf, LowConf: DblDyneVec; + ConfBand: double; Xmean, Ymean, R, Slope, Intercept: double; + Xmax, Xmin, Ymax, Ymin: double; N, PlotNo: integer); + procedure UpdateBtnStates; + + public + { public declarations } + end; + +var + ResistanceLineForm: TResistanceLineForm; + +implementation + +uses + Math; + +{ TResistanceLineForm } + +procedure TResistanceLineForm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + StdCorChk.Checked := false; + GridChk.Checked := false; + PlotMediansChk.Checked := false; + XEdit.Text := ''; + YEdit.Text := ''; + VarList.Clear; + ConfEdit.Text := FormatFloat('0.0', DEFAULT_CONFIDENCE_LEVEL_PERCENT); + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TResistanceLineForm.StdCorChkChange(Sender: TObject); +begin + if StdCorChk.Checked then GroupBox1.Enabled := true else GroupBox1.Enabled := false; +end; + +procedure TResistanceLineForm.ComputeBtnClick(Sender: TObject); +var + XYPoints : DblDyneMat; + XYMedians : DblDyneMat; + XMedians : DblDyneVec; + YMedians : DblDyneVec; + XVector, YVector : DblDyneVec; + cellstring, outline : string; + ColNoSelected : IntDyneVec; + UpConf : DblDyneVec; + lowConf : DblDyneVec; + GrpSize : IntDyneVec; + Xcol, Ycol, N, NoSelected, i, j, size, size1, size2, size3 : integer; + X, Y, tempX, tempY : double; + Xmin, Xmax, Ymin, Ymax, SSx, t, DF : double; + Xmean, Ymean, Xvariance, Yvariance, Xstddev, Ystddev, ConfBand : double; + R, SEPred, Slope, Intercept, predicted, sedata : double; + slope1, slope2 : double; + c, c1, c2, c3 : double; // constants obtained from control points + lReport: TStrings; +begin + SetLength(XYPoints, NoCases, NoCases); + SetLength(XYMedians, 3, 3); + SetLength(XMedians, 3); + SetLength(YMedians, 3); + SetLength(XVector, NoCases); + SetLength(YVector, NoCases); + SetLength(ColNoSelected, NoVariables); + SetLength(UpConf, NoCases + 1); + SetLength(lowConf, NoCases + 1); + SetLength(GrpSize, 3); + Xcol := 0; + Ycol := 0; + Xmax := -1.0e20; + Xmin := 1.0e20; + Ymax := -1.0e20; + Ymin := 1.0e20; + Xmean := 0.0; + Ymean := 0.0; + Xvariance := 0.0; + Yvariance := 0.0; + R := 0.0; + + for i := 1 to Novariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = XEdit.Text then Xcol := i; + if cellstring = YEdit.Text then Ycol := i; + end; + NoSelected := 2; + ColNoSelected[0] := Xcol; + ColNoSelected[1] := Ycol; + N := 0; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[Xcol,i])); + Y := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[Ycol,i])); + if X > Xmax then Xmax := X; + if X < Xmin then Xmin := X; + if Y > Ymax then Ymax := Y; + if Y < Ymin then Ymin := Y; + Xmean := Xmean + X; + Ymean := Ymean + Y; + Xvariance := Xvariance + X * X; + Yvariance := Yvariance + Y * Y; + R := R + X * Y; + XYPoints[N,0] := X; + XYPoints[N,1] := Y; + inc(N); + end; + + // sort on X values + for i := 0 to N-2 do + begin + for j := i + 1 to N-1 do + begin + if XYPoints[i,0] > XYPoints[j,0] then // swap + begin + tempX := XYPoints[i,0]; + tempY := XYPoints[i,1]; + XYPoints[i,0] := XYPoints[j,0]; + XYPoints[i,1] := XYPoints[j,1]; + XYPoints[j,0] := tempX; + XYPoints[j,1] := tempY; + end; + end; + end; + + // calculate statistics + Xvariance := Xvariance - Xmean * Xmean / N; + SSx := Xvariance; + Xvariance := Xvariance / (N - 1); + Xstddev := sqrt(Xvariance); + + Yvariance := Yvariance - Ymean * Ymean / N; + Yvariance := Yvariance / (N - 1); + Ystddev := sqrt(Yvariance); + + R := R - (Xmean * Ymean / N); + R := R / (N - 1); + R := R / (Xstddev * Ystddev); + + SEPred := sqrt(1.0 - (R * R)) * Ystddev; + SEPred := SEPred * sqrt((N - 1) / (N - 2)); + + Xmean := Xmean / N; + Ymean := Ymean / N; + Slope := R * Ystddev / Xstddev; + Intercept := Ymean - Slope * Xmean; + + // Now, print the descriptive statistics if requested + lReport := TStringList.Create; + try + if DescChk.Checked then + begin + lReport.Add('Original X versus Y Plot Data'); + lReport.Add(''); + lReport.Add('X = %s, Y = %s from file: %s',[ + Xedit.Text, YEdit.Text, OS3MainFrm.FileNameEdit.Text + ]); + lReport.Add(''); + lReport.Add('Variable Mean Variance Std.Dev.'); + lReport.Add('%-10s%8.2f %8.2f %8.2f', [XEdit.Text, Xmean, Xvariance, Xstddev]); + lReport.Add('%-10s%8.2f %8.2f %8.2f', [YEdit.Text, Ymean, Yvariance, Ystddev]); + lReport.Add(''); + lReport.Add('Correlation: %8.4f', [R]); + lReport.Add('Slope: %8.2f', [Slope]); + lReport.Add('Intercept: %8.2f', [Intercept]); + lReport.Add('Standard Error of Estimate: %8.2f', [SEPred]); + lReport.Add('Number of good cases: %8d', [N]); + lReport.Add(''); + end; + + // get upper and lower confidence points for each X value + if ConfChk.Checked then + begin + ConfBand := StrToFloat(ConfEdit.Text) / 100.0; + DF := N - 2; + t := inverset(ConfBand,DF); + for i := 1 to N do + begin + X := XYpoints[i-1,0]; + predicted := slope * X + intercept; + sedata := SEPred * sqrt(1.0 + (1.0 / N) + (sqr(X - Xmean) / SSx)); + UpConf[i] := predicted + (t * sedata); + lowConf[i] := predicted - (t * sedata); + if UpConf[i] > Ymax then Ymax := UpConf[i]; + if lowConf[i] < Ymin then Ymin := lowConf[i]; + end; + end else + ConfBand := 0.0; + + // plot the values (and optional line and confidence band if elected) + if PointsChk.Checked then + begin + for i := 0 to N-1 do + begin + XVector[i] := XYPoints[i,0]; + YVector[i] := XYPoints[i,1]; + end; + PlotXY( + XVector, YVector, UpConf, LowConf, ConfBand, Xmean, Ymean, R, + Slope, Intercept, Xmax, Xmin, Ymax, Ymin, N, 1 + ); + end; + //LineChk.Checked := false; + //ConfChk.Checked := false; + ConfBand := 0.0; + + // Now do the resistant line analysis + // obtain 1/3 size + size := n div 3; + size1 := size; + size3 := size; + size2 := n - size1 - size3; + GrpSize[0] := size1; + GrpSize[1] := size2; + GrpSize[2] := size3; + + // get median for each group of x and y values + // first group: + for i := 0 to size1-1 do + begin + XVector[i] := XYPoints[i,0]; + YVector[i] := XYPoints[i,1]; + end; + XMedians[0] := Median(XVector,size1); + YMedians[0] := Median(YVector,size1); + + // second group + j := 0; + for i := size1 to size1 + size2 - 1 do + begin + XVector[j] := XYPoints[i,0]; + YVector[j] := XYPoints[i,1]; + inc(j); + end; + XMedians[1] := Median(XVector,size2); + YMedians[1] := Median(YVector,size2); + + // third group + j := 0; + for i := (size1 + size2) to N-1 do + begin + XVector[j] := XYPoints[i,0]; + YVector[j] := XYPoints[i,1]; + inc(j); + end; + XMedians[2] := Median(XVector,size3); + YMedians[2] := Median(YVector,size3); + + lReport.Add('Group X Median Y Median Size'); + for i := 0 to 2 do + lReport.Add('%3d %5.3f %5.3f %d', [i+1, XMedians[i], YMedians[i], GrpSize[i]]); + lReport.Add(''); + + slope1 := (YMedians[1] - YMedians[0]) / (XMedians[1] - XMedians[0]); + slope2 := (YMedians[2] - YMedians[1]) / (XMedians[2] - XMedians[1]); + lReport.Add('Half Slopes: %10.3f and %.3f', [slope1, slope2]); + + Slope := (YMedians[2] - YMedians[0]) / (XMedians[2] - XMedians[0]); + lReport.Add('Slope: %10.3f', [Slope]); + + tempx := slope2 / slope1; + lReport.Add('Ratio of half slopes: %10.3f',[tempx]); + + // obtain estimate of the constant for the prediction equation + c1 := slope * XMedians[0] - YMedians[0]; + c2 := slope * XMedians[1] - YMedians[1]; + c3 := slope * XMedians[2] - YMedians[2]; + c := (c1 + c2 + c3) / 3.0; + lReport.Add('Equation: y := %.3f * X + (%.3f)', [slope, c]); + + if GridChk.Checked then + begin + // Get the residuals (Y - predicted Y) for each X value and place in the grid + outline := 'Pred.' + OS3MainFrm.DataGrid.Cells[Ycol,0]; + DictionaryFrm.NewVar(NoVariables+1); + DictionaryFrm.DictGrid.Cells[1,NoVariables] := outline; + OS3MainFrm.DataGrid.Cells[NoVariables,0] := outline; + + outline := 'Residual'; + DictionaryFrm.NewVar(NoVariables+1); + DictionaryFrm.DictGrid.Cells[1,NoVariables] := outline; + OS3MainFrm.DataGrid.Cells[NoVariables,0] := outline; + + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[Xcol,i])); + Y := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[Ycol,i])); + if c >= 0 then + predicted := slope * X + c + else + predicted := slope * X - c; + Y := Y - predicted; // residual + outline := Format('%9.3f',[predicted]); + OS3MainFrm.DataGrid.Cells[NoVariables-1,i] := outline; + outline := Format('%9.3f',[Y]); + OS3MainFrm.DataGrid.Cells[NoVariables,i] := outline; + end; + end; + + DisplayReport(lReport); + + // plot the values (and optional line and confidence band if elected) + if PlotMediansChk.Checked then + PlotXY( + XMedians, YMedians, UpConf, LowConf, ConfBand, Xmean, Ymean, R, + Slope, Intercept, Xmax, Xmin, Ymax, Ymin, 3, 2 + ); + + finally + lReport.Free; + GrpSize := nil; + LowConf := nil; + UpConf := nil; + ColNoSelected := nil; + YVector := nil; + XVector := nil; + YMedians := nil; + XMedians := nil; + XYMedians := nil; + XYPoints := nil; + end; +end; + +procedure TResistanceLineForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + //VarList.Constraints.MinWidth := XEdit.Width; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TResistanceLineForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + + if BlankFrm = nil then Application.CreateForm(TBlankFrm, BlankFrm); + if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TResistanceLineForm.XInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (XEdit.Text = '') then + begin + XEdit.Text := VarList.items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TResistanceLineForm.XOutBtnClick(Sender: TObject); +begin + if XEdit.Text <> '' then + begin + VarList.Items.Add(XEdit.Text); + XEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TResistanceLineForm.YInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (YEdit.Text = '') then + begin + YEdit.Text := VarList.items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TResistanceLineForm.YOutBtnClick(Sender: TObject); +begin + if YEdit.Text <> '' then + begin + VarList.Items.Add(YEdit.Text); + YEdit.Text := ''; + end; + UpdateBtnStates; +end; + +function TResistanceLineForm.Median(VAR X: DblDyneVec; ASize: integer): double; +var + midpt: integer; + value: double; + i, j: integer; +begin + // sort values + for i := 0 to ASize-2 do + begin + for j := i + 1 to ASize-1 do + begin + if X[i] > X[j] then // swap + begin + value := X[i]; + X[i] := X[j]; + X[j] := value; + end; + end; + end; + + if ASize > 2 then + begin + midpt := ASize div 2; + if 2 * midpt = ASize then // even no. of values + begin + value := (X[midpt-1] + X[midpt]) / 2; + end else + value := X[midpt]; // odd no. of values + Median := value; + end else + if ASize = 2 then + Median := (X[0] + X[1]) / 2; + + Result := Median; +end; + +procedure TResistanceLineForm.PlotXY(var Xpoints, Ypoints, UpConf, LowConf: DblDyneVec; + ConfBand, XMean, YMean, R, Slope, Intercept: double; + Xmax, Xmin, Ymax, Ymin: double; N, PlotNo: integer); +var + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide: integer; + vhi, hwide, offset, strhi, imagehi: integer; + valincr, Yvalue, Xvalue: double; + Title: string; + YU, YL, XU, XL: double; +begin + BlankFrm.Image1.Canvas.Clear; + if PlotNo = 1 then + begin + Title := 'X versus Y PLOT Using File: ' + OS3MainFrm.FileNameEdit.Text; + BlankFrm.Caption := Title; + end + else + begin + Title := 'Median Plot for three groups'; + BlankFrm.Caption := Title; + end; + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + vtop := 40; + vbottom := round(imagehi) - 80; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + + // Draw chart border + BlankFrm.Image1.Canvas.Rectangle(0,0,imagewide,imagehi); + + // draw Means + if MeansChk.Checked then + begin + ypos := round(vhi * ( (Ymax - Ymean) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clGreen; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'MEAN '; + Title := Title + YEdit.Text; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + xpos := round(hwide * ( (Xmean - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + ypos := vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := vbottom; + BlankFrm.Image1.Canvas.Pen.Color := clGreen; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'MEAN '; + Title := Title + XEdit.Text; + strhi := BlankFrm.Image1.Canvas.TextWidth(Title); + xpos := xpos - strhi div 2; + ypos := vtop - BlankFrm.Image1.Canvas.TextHeight(Title); + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + + // draw slope line + if LineChk.Checked then + begin + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + Yvalue := (Xpoints[0] * slope) + intercept; // predicted score + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[0]- Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + Yvalue := (Xpoints[N-1] * slope) + intercept; // predicted score + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[N-1] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // draw horizontal axis + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom); + valincr := (Xmax - Xmin) / 10.0; + for i := 1 to 11 do + begin + ypos := vbottom; + Xvalue := Xmin + valincr * (i - 1); + xpos := round(hwide * ((Xvalue - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := format('%.2f',[Xvalue]); + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + xpos := xpos - offset; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + if PlotNo = 1 then + begin + xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(XEdit.Text) div 2); + ypos := vbottom + 20; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,XEdit.Text); + Title := format('R(X,Y) = %.3f, Slope = %.2f, Intercept = %.2f', + [R,Slope,Intercept]); + xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(Title) div 2); + ypos := ypos + 15; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + + // Draw vertical axis + Title := YEdit.Text; + xpos := hleft - BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + ypos := vtop - BlankFrm.Image1.Canvas.TextHeight(Title) - 10; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,YEdit.Text); + xpos := hleft; + ypos := vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := vbottom; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + valincr := (Ymax - Ymin) / 10.0; + for i := 1 to 11 do + begin + Title := format('%.2f',[Ymax - ((i-1)*valincr)]); + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := hLeft - 20 - BlankFrm.Image1.Canvas.TextWidth(Title); //10; + Yvalue := Ymax - (valincr * (i-1)); + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + xpos := hleft; + ypos := ypos + strhi div 2; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hleft - 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // draw points for x and y pairs + for i := 0 to N-1 do + begin + ypos := round(vhi * ( (Ymax - Ypoints[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.Brush.Color := clYellow; + BlankFrm.Image1.Canvas.Brush.Style := bsSolid; + BlankFrm.Image1.Canvas.Pen.Color := clNavy; + BlankFrm.Image1.Canvas.Ellipse(xpos,ypos,xpos+5,ypos+5); + if ((PlotNo = 2) and (i = 0)) then + begin + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'M1'); + end; + if ((PlotNo = 2) and (i > 0)) then + begin + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := format('M%d',[i+1]); + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + end; + if ((PlotNo = 2) and (i > 0)) then + begin // draw slope line + BlankFrm.Image1.Canvas.Pen.Color := clRed; + ypos := round(vhi * ( (Ymax - Ypoints[0]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[0] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + YL := Ypoints[0]; + XL := xpoints[0]; + ypos := round(vhi * ( (Ymax - Ypoints[2]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[2] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + YU := Ypoints[2]; + XU := xpoints[2]; + slope := (YU - YL) / (XU - XL); + ypos := vbottom + 20; + BlankFrm.Image1.Canvas.Brush.Color := clYellow; + Title := format('Slope = %.2f',[Slope]); + xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(Title) div 2); + ypos := ypos + 15; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + + // draw confidence bands if requested + if ConfBand <> 0.0 then + begin + BlankFrm.Image1.Canvas.Pen.Color := clRed; + ypos := round(vhi * ((Ymax - UpConf[1]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[0] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + for i := 2 to N do + begin + ypos := round(vhi * ((Ymax - UpConf[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i-1] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + ypos := round(vhi * ((Ymax - lowConf[1]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[0] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + for i := 2 to N do + begin + ypos := round(vhi * ((Ymax - lowConf[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i-1] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + end; + BlankFrm.ShowModal; +end; + +procedure TResistanceLineForm.UpdateBtnStates; +begin + XInBtn.Enabled := (VarList.ItemIndex > -1) and (XEdit.Text = ''); + YInBtn.Enabled := (VarList.ItemIndex > -1) and (YEdit.Text = ''); + XOutBtn.Enabled := (XEdit.Text <> ''); + YOutBtn.Enabled := (YEdit.Text <> ''); +end; + +procedure TResistanceLineForm.VarListSelectionChange(Sender: TObject; + User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I resistancelineunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/rot3dunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/rot3dunit.lfm new file mode 100644 index 000000000..603da14e2 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/rot3dunit.lfm @@ -0,0 +1,416 @@ +object Rot3DFrm: TRot3DFrm + Left = 358 + Height = 527 + Top = 153 + Width = 710 + Caption = 'Three Dimension Rotation' + ClientHeight = 527 + ClientWidth = 710 + OnActivate = FormActivate + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = VarList + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 561 + Height = 15 + Top = 8 + Width = 102 + BorderSpacing.Top = 8 + Caption = 'Click the X, Y and Z' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = VarList + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + Left = 564 + Height = 15 + Top = 23 + Width = 97 + Caption = 'Variables to Rotate' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = XScroll + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Label6 + Left = 530 + Height = 15 + Top = 188 + Width = 7 + Anchors = [akLeft, akBottom] + Caption = 'X' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = YScroll + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Label7 + Left = 609 + Height = 15 + Top = 188 + Width = 7 + Anchors = [akLeft, akBottom] + Caption = 'Y' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = ZScroll + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Label8 + Left = 689 + Height = 15 + Top = 188 + Width = 7 + Anchors = [akLeft, akBottom] + Caption = 'Z' + ParentColor = False + end + object Label6: TLabel + AnchorSideLeft.Control = XScroll + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = XScroll + Left = 525 + Height = 15 + Top = 203 + Width = 17 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Caption = '-90' + ParentColor = False + end + object Label7: TLabel + AnchorSideLeft.Control = YScroll + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = YScroll + Left = 604 + Height = 15 + Top = 203 + Width = 17 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Caption = '-90' + ParentColor = False + end + object Label8: TLabel + AnchorSideLeft.Control = ZScroll + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = ZScroll + Left = 684 + Height = 15 + Top = 203 + Width = 17 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Caption = '-90' + ParentColor = False + end + object Label9: TLabel + AnchorSideLeft.Control = XScroll + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Label10 + Left = 527 + Height = 15 + Top = 417 + Width = 12 + Caption = '90' + ParentColor = False + end + object Label10: TLabel + AnchorSideLeft.Control = YScroll + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = YScroll + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = Label12 + Left = 606 + Height = 15 + Top = 417 + Width = 12 + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 4 + Caption = '90' + ParentColor = False + end + object Label11: TLabel + AnchorSideLeft.Control = ZScroll + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Label10 + Left = 686 + Height = 15 + Top = 417 + Width = 12 + Caption = '90' + ParentColor = False + end + object Label12: TLabel + AnchorSideLeft.Control = YScroll + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Label10 + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = YDegEdit + Left = 591 + Height = 15 + Top = 432 + Width = 42 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 16 + Caption = 'Degrees' + ParentColor = False + end + object Label13: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = XEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 499 + Width = 7 + BorderSpacing.Left = 8 + Caption = 'X' + ParentColor = False + end + object Label14: TLabel + AnchorSideLeft.Control = XEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = YEdit + AnchorSideTop.Side = asrCenter + Left = 104 + Height = 15 + Top = 499 + Width = 7 + BorderSpacing.Left = 24 + Caption = 'Y' + ParentColor = False + end + object Label15: TLabel + AnchorSideLeft.Control = YEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ZEdit + AnchorSideTop.Side = asrCenter + Left = 200 + Height = 15 + Top = 499 + Width = 7 + BorderSpacing.Left = 24 + Caption = 'Z' + ParentColor = False + end + object Image1: TImage + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = VarList + AnchorSideBottom.Control = CloseBtn + Left = 8 + Height = 478 + Top = 8 + Width = 506 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + end + object VarList: TListBox + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Label4 + Left = 522 + Height = 140 + Top = 40 + Width = 180 + Anchors = [akTop, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + OnClick = VarListClick + TabOrder = 0 + end + object XScroll: TScrollBar + AnchorSideLeft.Control = VarList + AnchorSideBottom.Control = YScroll + AnchorSideBottom.Side = asrBottom + Left = 522 + Height = 191 + Top = 222 + Width = 22 + Anchors = [akLeft, akBottom] + Kind = sbVertical + PageSize = 0 + TabOrder = 1 + OnScroll = XScrollScroll + end + object YScroll: TScrollBar + AnchorSideLeft.Control = VarList + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Label10 + Left = 601 + Height = 191 + Top = 222 + Width = 22 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Kind = sbVertical + PageSize = 0 + TabOrder = 2 + OnScroll = YScrollScroll + end + object ZScroll: TScrollBar + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = YScroll + AnchorSideBottom.Side = asrBottom + Left = 683 + Height = 191 + Top = 222 + Width = 19 + Anchors = [akRight, akBottom] + BorderSpacing.Right = 8 + Kind = sbVertical + PageSize = 0 + TabOrder = 3 + OnScroll = ZScrollScroll + end + object XDegEdit: TEdit + AnchorSideLeft.Control = XScroll + AnchorSideTop.Control = YDegEdit + AnchorSideBottom.Control = CloseBtn + Left = 522 + Height = 23 + Top = 463 + Width = 35 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 8 + TabOrder = 4 + Text = 'XDegEdit' + end + object YDegEdit: TEdit + AnchorSideLeft.Control = YScroll + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = XDegEdit + Left = 595 + Height = 23 + Top = 463 + Width = 35 + TabOrder = 5 + Text = 'XDegEdit' + end + object ZDegEdit: TEdit + AnchorSideTop.Control = XDegEdit + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 667 + Height = 23 + Top = 463 + Width = 35 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + TabOrder = 6 + Text = 'XDegEdit' + end + object XEdit: TEdit + AnchorSideLeft.Control = Label13 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CloseBtn + AnchorSideTop.Side = asrCenter + Left = 23 + Height = 23 + Top = 495 + Width = 57 + BorderSpacing.Left = 8 + TabOrder = 7 + Text = 'XEdit' + end + object YEdit: TEdit + AnchorSideLeft.Control = Label14 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CloseBtn + AnchorSideTop.Side = asrCenter + Left = 119 + Height = 23 + Top = 495 + Width = 57 + BorderSpacing.Left = 8 + TabOrder = 8 + Text = 'YEdit' + end + object ZEdit: TEdit + AnchorSideLeft.Control = Label15 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CloseBtn + AnchorSideTop.Side = asrCenter + Left = 215 + Height = 23 + Top = 495 + Width = 56 + BorderSpacing.Left = 8 + TabOrder = 9 + Text = 'ZEdit' + end + object ResetBtn: TButton + AnchorSideRight.Control = PrintBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 526 + Height = 25 + Top = 494 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 10 + end + object PrintBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 588 + Height = 25 + Top = 494 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Print' + OnClick = PrintBtnClick + TabOrder = 11 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 647 + Height = 25 + Top = 494 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 12 + end + object PrintDialog: TPrintDialog + left = 320 + top = 304 + end + object PrinterSetupDialog1: TPrinterSetupDialog + left = 184 + top = 304 + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/rot3dunit.pas b/applications/lazstats/source/forms/analysis/descriptive/rot3dunit.pas new file mode 100644 index 000000000..70bd31d48 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/rot3dunit.pas @@ -0,0 +1,592 @@ +unit Rot3dUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Printers, PrintersDlgs, + MainUnit, Globals, DataProcs; + + +type + + { TRot3DFrm } + + TRot3DFrm = class(TForm) + Image1: TImage; + PrintDialog: TPrintDialog; + PrinterSetupDialog1: TPrinterSetupDialog; + ResetBtn: TButton; + PrintBtn: TButton; + CloseBtn: TButton; + ZEdit: TEdit; + Label15: TLabel; + YEdit: TEdit; + Label14: TLabel; + XEdit: TEdit; + Label13: TLabel; + XDegEdit: TEdit; + Label1: TLabel; + Label10: TLabel; + Label11: TLabel; + Label12: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Label7: TLabel; + Label8: TLabel; + Label9: TLabel; + XScroll: TScrollBar; + YScroll: TScrollBar; + ZScroll: TScrollBar; + VarList: TListBox; + YDegEdit: TEdit; + ZDegEdit: TEdit; + procedure CancelBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure PrintBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListClick(Sender: TObject); + procedure XScrollScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); + procedure YScrollScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); + procedure ZScrollScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); + private + { private declarations } + DXmax, DXmin, DYmax, DYmin : integer; + WXleft, WXright, WYtop, WYbottom, RX, RY, RZ : double; + SINRX, COSRX, SINRY, COSRY, SINRZ, COSRZ : double; + GridColX, GridColY, GridColZ : integer; + degX, degY, degZ : double; + XScaled : DblDyneVec; + YScaled : DblDyneVec; + ZScaled : DblDyneVec; + + procedure Rotate(Sender: TObject); + function DegToRad(deg : double; Sender: TObject) : double; + function World3DToWorld2D(p : POINT3D; Sender: TObject) : POINT3D; + function World2DToDevice(p :POINT3D; Sender: TObject) : POINTint; + procedure DrawPoint( p1 : POINT3D; Sender: TObject); + procedure DrawLine(p1, p2 : POINT3D; Sender: TObject); + procedure DrawAxis(Sender: TObject); + procedure SetAxesAngles(rx1, ry1, rz1 : double; Sender: TObject); + procedure ScaleValues(Sender: TObject); + procedure EraseAxis(Sender: TObject); + + public + { public declarations } + end; + +var + Rot3DFrm: TRot3DFrm; + +implementation + +uses + Math; + +{ TRot3DFrm } + +procedure TRot3DFrm.ResetBtnClick(Sender: TObject); +var i : integer; +begin + VarList.Items.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + XScroll.Position := 0; + YScroll.Position := 0; + ZScroll.Position := 0; + // set device limits + DXmin := 36; + DXmax := 436; + DYmin := 36; + DYmax := 436; + // set world limits + WXleft := -1.0; + WYbottom := -1.0; + WXright := 1.0; + WYtop := 1.0; + XDegEdit.Text := '0'; + YDegEdit.Text := '0'; + ZDegEdit.Text := '0'; + XEdit.Text := ''; + YEdit.Text := ''; + ZEdit.Text := ''; +end; + +procedure TRot3DFrm.VarListClick(Sender: TObject); +var + i, index : integer; + Xvar, Yvar, Zvar : string; + +begin + index := VarList.ItemIndex; + if XEdit.Text = '' then + begin + XEdit.Text := VarList.Items.Strings[index]; + exit; + end; + if YEdit.Text = '' then + begin + YEdit.Text := VarList.Items.Strings[index]; + exit; + end; + ZEdit.Text := VarList.Items.Strings[index]; + // Get column no.s of selected variables + Xvar := XEdit.Text; + Yvar := YEdit.Text; + Zvar := ZEdit.Text; + for i := 1 to NoVariables do + begin + if Xvar = OS3MainFrm.DataGrid.Cells[i,0] then GridColX := i; + if Yvar = OS3MainFrm.DataGrid.Cells[i,0] then GridColY := i; + if Zvar = OS3MainFrm.DataGrid.Cells[i,0] then GridColZ := i; + end; + ScaleValues(self); // get scaled X, y and Z values (-1.0 to 1.0) + XScroll.Position := 20; + YScroll.Position := -15; + ZScroll.Position := -5; + Canvas.Pen.Color := clBlack; + Rotate(self); +end; + +procedure TRot3DFrm.XScrollScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); +begin + Rotate(self); +end; + +procedure TRot3DFrm.YScrollScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); +begin + Rotate(self); +end; + +procedure TRot3DFrm.ZScrollScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); +begin + Rotate(self); +end; + +procedure TRot3DFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TRot3DFrm.PrintBtnClick(Sender: TObject); +var + labelstr : string; + p1, p2, p, pa, pb : POINT3D; + p11, p22 : POINTint; + i, t, X : integer; + offset, Clwidth, Clheight : double; + +begin + if not PrintDialog.Execute then + exit; + + labelstr := '3D PLOT'; + Clwidth := Printer.PageWidth; + Clheight := Clwidth; + offset := Clwidth / 20.0; + + Clwidth := Clwidth - (Clwidth / 20.0); + Printer.BeginDoc; + try + // First, draw axis + p1.x := -1; + p1.y := 0; + p1.z := 0; + p2.x := 1; + p2.y := 0; + p2.z := 0; + Printer.Canvas.Pen.Color := clRed; + + //draw a 3d line + p1.z := -p1.z; + p2.z := -p2.z; + pa := World3DToWorld2D(p1,self); + pb := World3DToWorld2D(p2,self); + + // scale it up + p11.x := round((WXleft-pa.x)*(Clwidth-offset) / (WXleft - WXright)+ offset + 0.5); + p11.y := round((WYtop-pa.y)*(Clheight-offset) / (WYtop-WYbottom) + offset + 0.5); + p22.x := round((WXleft-pb.x)*(Clwidth-offset) / (WXleft - WXright) + offset + 0.5); + p22.y := round((WYtop-pb.y)*(Clheight-offset) / (WYtop-WYbottom) + offset + 0.5); + Printer.Canvas.MoveTo(p11.x,p11.y); + Printer.Canvas.LineTo(p22.x,p22.y); + p1.x := 0; + p1.y := -1; + p2.x := 0; + p2.y := 1; + p2.z := 0; + Printer.Canvas.Pen.Color := clBlue; + + //draw a 3d line + p1.z := -p1.z; + p2.z := -p2.z; + pa := World3DToWorld2D(p1,self); + pb := World3DToWorld2D(p2,self); + + // scale it up + p11.x := round((WXleft-pa.x)*(Clwidth-offset) / (WXleft - WXright)+ offset + 0.5); + p11.y := round((WYtop-pa.y)*(Clheight-offset) / (WYtop-WYbottom) + offset + 0.5); + p22.x := round((WXleft-pb.x)*(Clwidth-offset) / (WXleft - WXright) + offset + 0.5); + p22.y := round((WYtop-pb.y)*(Clheight-offset) / (WYtop-WYbottom) + offset + 0.5); + Printer.Canvas.MoveTo(p11.x,p11.y); + Printer.Canvas.LineTo(p22.x,p22.y); + p1.y := 0; + p1.z := -1; + p2.x := 0; + p2.y := 0; + p2.z := 1; + Printer.Canvas.Pen.Color := clGreen; + + //draw a 3d line + p1.z := -p1.z; + p2.z := -p2.z; + pa := World3DToWorld2D(p1,self); + pb := World3DToWorld2D(p2,self); + + // scale it up + p11.x := round((WXleft-pa.x)*(Clwidth-offset) / (WXleft - WXright)+ offset + 0.5); + p11.y := round((WYtop-pa.y)*(Clheight-offset) / (WYtop-WYbottom) + offset + 0.5); + p22.x := round((WXleft-pb.x)*(Clwidth-offset) / (WXleft - WXright) + offset + 0.5); + p22.y := round((WYtop-pb.y)*(Clheight-offset) / (WYtop-WYbottom) + offset + 0.5); + Printer.Canvas.MoveTo(p11.x,p11.y); + Printer.Canvas.LineTo(p22.x,p22.y); + Printer.Canvas.Pen.Color := clBlack; + + //Now, plot points + for i := 1 to NoCases do + begin + p.x := XScaled[i]; + p.y := YScaled[i]; + p.z := ZScaled[i]; + // draws a 3d point + p.z := -p.z; + pa := World3DToWorld2D(p,self); + // scale it up + p11.x := round((WXleft-pa.x)*(Clwidth-offset) / (WXleft - WXright) + offset + 0.5); + p11.y := round((WYtop-pa.y)*(Clheight-offset) / (WYtop-WYbottom) + offset + 0.5); + Printer.Canvas.Rectangle(p11.x - 4,p11.y - 4,p11.x + 4, p11.y + 4); + end; + + // Print Heading + t := Printer.Canvas.TextWidth(labelstr); + X := round((Clwidth / 2.0) - (t / 2.0)); + Printer.Canvas.TextOut(X,0,labelstr); + labelstr := 'RED := X, BLUE := Y, GREEN := Z'; + t := Printer.Canvas.TextWidth(labelstr); + X := round((Clwidth / 2.0) - (t / 2.0)); + Printer.Canvas.TextOut(X,round(Clheight),labelstr); + labelstr := XEdit.Text; + labelstr := labelstr + ' '; + labelstr := labelstr + YEdit.Text; + labelstr := labelstr + ' '; + labelstr := labelstr + ZEdit.Text; + t := Printer.Canvas.TextWidth(labelstr); + X := round((Clwidth / 2.0) - (t / 2.0)); + Printer.Canvas.TextOut(X,round(Clheight+40.0),labelstr); + labelstr := 'ROTATION: X deg. := '; + labelstr := labelstr + XDegEdit.Text; + labelstr := labelstr + ' Y deg. := '; + labelstr := labelstr + YDegEdit.Text; + labelstr := labelstr + ' Z deg. := '; + labelstr := labelstr + ZDegEdit.Text; + t := Printer.Canvas.TextWidth(labelstr); + X := round((Clwidth / 2.0) - (t / 2)); + Printer.Canvas.TextOut(X,round(Clheight+80.0),labelstr); + + finally + Printer.EndDoc; // finish printing + end; +end; + +procedure TRot3DFrm.CancelBtnClick(Sender: TObject); +begin + ZScaled := nil; + YScaled := nil; + XScaled := nil; + Close; +end; + +procedure TRot3DFrm.Rotate(Sender: TObject); +var + p: POINT3D; + i: integer; +begin + Image1.Canvas.Brush.Style := bsSolid; + Image1.Canvas.Brush.Color := clLtGray; + Image1.Canvas.FillRect(0, 0, Image1.Width, Image1.Height); + + Image1.Canvas.Brush.Color := clWhite; + Image1.Canvas.Pen.Color := clBlack; + Image1.Canvas.Rectangle(20,20,460,460); + + //First, erase current points + Image1.Canvas.Pen.Color := clWhite; + Image1.Canvas.Brush.Color := clWhite; + for i := 1 to NoCases do + begin + p.x := XScaled[i]; + p.y := YScaled[i]; + p.z := ZScaled[i]; + DrawPoint(p,self); + end; + EraseAxis(self); + Image1.Canvas.Brush.Color := clBlack; + Image1.Canvas.Pen.Color := clBlack; + degX := XScroll.Position; + degY := YScroll.Position; + degZ := ZScroll.Position; + XDegEdit.Text := IntToStr(XScroll.Position); + YDegEdit.Text := IntToStr(YScroll.Position); + ZDegEdit.Text := IntToStr(ZScroll.Position); + SetAxesAngles(degX, degY, degZ,self); + DrawAxis(self); + for i := 1 to NoCases do + begin + p.x := XScaled[i]; + p.y := YScaled[i]; + p.z := ZScaled[i]; + DrawPoint(p,self); + end; +end; +//--------------------------------------------------------------------------- + +function TRot3DFrm.DegToRad(deg : double; Sender: TObject) : double; +begin + Result := deg * PI / 180.0; +end; +//--------------------------------------------------------------------------- + +function TRot3DFrm.World3DToWorld2D(p : POINT3D; Sender: TObject) : POINT3D; +var + ptemp : POINT3D; +begin + ptemp := p; + if RX <> 0.0 then begin + ptemp.x := p.x; + ptemp.y := COSRX * p.y - SINRX * p.z; + ptemp.z := SINRX * p.y + COSRX * p.z; + p := ptemp; + end; + if RY <> 0.0 then begin + ptemp.x := COSRY * p.x + SINRY * p.z; + ptemp.y := p.y; + ptemp.z := SINRY * p.x + COSRY * p.z; + p := ptemp; + end; + if RZ <> 0.0 then begin + ptemp.x := COSRZ * p.x - SINRZ * p.y; + ptemp.y := SINRZ * p.x + COSRZ * p.y; + ptemp.z := p.z; + end; + if abs(ptemp.x) < TOL then ptemp.x := 0.0; + if abs(ptemp.y) < TOL then ptemp.y := 0.0; + if abs(ptemp.z) < TOL then ptemp.z := 0.0; + Result := ptemp; +end; +//--------------------------------------------------------------------------- + +function TRot3DFrm.World2DToDevice(p :POINT3D; Sender: TObject) : POINTint; +var + ptemp : POINTint; +begin + ptemp.x := round((WXleft - p.x) * (DXmax - DXmin) / (WXleft - WXright) + DXmin + 0.5); + ptemp.y := round((WYtop - p.y) * (DYmax - DYmin) / (WYtop - WYbottom) + DYmin + 0.5); + Result := ptemp; +end; +//--------------------------------------------------------------------------- + +procedure TRot3DFrm.DrawPoint( p1 : POINT3D; Sender: TObject); +var + p2 : POINTint; +begin + // draws a 3d point + p1.z := -p1.z; + p2 := World2DToDevice(World3DToWorld2D(p1,self),self); + Image1.Canvas.Rectangle(p2.x - 2,p2.y - 2,p2.x + 2, p2.y + 2); +end; +//--------------------------------------------------------------------------- + +procedure TRot3DFrm.DrawLine(p1, p2 : POINT3D; Sender: TObject); +var + p11, p22 : POINTint; +begin + //draws a 3d line + p1.z := -p1.z; + p2.z := -p2.z; + p11 := World2DToDevice(World3DToWorld2D(p1,self),self); + p22 := World2DToDevice(World3DToWorld2D(p2,self),self); + Image1.Canvas.MoveTo(p11.x,p11.y); + Image1.Canvas.LineTo(p22.x,p22.y); +end; +//--------------------------------------------------------------------------- + +procedure TRot3DFrm.DrawAxis(Sender: TObject); +var + p1, p2 : POINT3D; +begin + p1.x := -1; + p1.y := 0; + p1.z := 0; + p2.x := 1; + p2.y := 0; + p2.z := 0; + Image1.Canvas.Pen.Color := clRed; + drawline(p1,p2,self); + p1.x := 0; + p1.y := -1; + p2.x := 0; + p2.y := 1; + p2.z := 0; + Image1.Canvas.Pen.Color := clBlue; + drawline(p1,p2,self); + p1.y := 0; + p1.z := -1; + p2.x := 0; + p2.y := 0; + p2.z := 1; + Image1.Canvas.Pen.Color := clGreen; + drawline(p1,p2,self); + Image1.Canvas.Pen.Color := clWhite; +end; +//--------------------------------------------------------------------------- + +procedure TRot3DFrm.SetAxesAngles(rx1, ry1, rz1 : double; Sender: TObject); +begin + RX := DegToRad(rx1,self); + RY := DegToRad(ry1,self); + RZ := DegToRad(rz1,self); + COSRX := cos(RX); + SINRX := sin(RX); + COSRY := cos(RY); + SINRY := sin(RY); + COSRZ := cos(RZ); + SINRZ := sin(RZ); +end; +//--------------------------------------------------------------------------- + +procedure TRot3DFrm.ScaleValues(Sender: TObject); +var + Xmax, Ymax, Zmax, Xmin, Ymin, Zmin, value, prop : double; + i, NoSelected : integer; + ColNoSelected : IntDyneVec; + +begin + // This routine scales the X, Y and Z values in the grid to new + // values ranging from -1 to 1 for each. The arrays of scaled + // values are pointed to by the private float pointers XScaled, + // YScaled and ZScaled; + + SetLength(ColNoSelected,NoVariables); + SetLength(XScaled,NoCases+1); + SetLength(YScaled,NoCases+1); + SetLength(ZScaled,NoCases+1); + + ColNoSelected[0] := GridColX; + ColNoSelected[1] := GridColY; + ColNoSelected[2] := GridColZ; + NoSelected := 3; + Xmax := StrToFloat(OS3MainFrm.DataGrid.Cells[GridColX,1]); + Xmin := Xmax; + Ymin := StrToFloat(OS3MainFrm.DataGrid.Cells[GridColY,1]); + Ymax := Ymin; + Zmax := StrToFloat(OS3MainFrm.DataGrid.Cells[GridColZ,1]); + Zmin := Zmax; + for i := 1 to NoCases do + begin + if Not GoodRecord(i,NoSelected,ColNoSelected) then continue; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[GridColX,i]); + if (value > Xmax) then Xmax := value; + if (value < Xmin) then Xmin := value; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[GridColY,i]); + if (value > Ymax) then Ymax := value; + if (value < Ymin) then Ymin := value; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[GridColZ,i]); + if (value > Zmax) then Zmax := value; + if (value < Zmin) then Zmin := value; + end; + // now scale values + for i := 1 to NoCases do + begin + if Not GoodRecord(i,NoSelected,ColNoSelected) then continue; + value := StrTofloat(OS3MainFrm.DataGrid.Cells[GridColX,i]); + prop := (Xmax - value) / (Xmax - Xmin); + XScaled[i] := prop - 0.5; //scale between -1 and +1 + value := StrToFloat(OS3MainFrm.DataGrid.Cells[GridColY,i]); + prop := (Ymax - value) / (Ymax - Ymin); + YScaled[i] := prop - 0.5; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[GridColZ,i]); + prop := (Zmax - value) / (Zmax - Zmin); + ZScaled[i] := prop - 0.5; + end; + ColNoSelected := nil; +end; +//------------------------------------------------------------------- + +procedure TRot3DFrm.EraseAxis(Sender: TObject); +var + p1, p2 : POINT3D; +begin + p1.x := -1; + p1.y := 0; + p1.z := 0; + p2.x := 1; + p2.y := 0; + p2.z := 0; + Image1.Canvas.Pen.Color := clWhite; + drawline(p1,p2,self); + p1.x := 0; + p1.y := -1; + p2.x := 0; + p2.y := 1; + p2.z := 0; + drawline(p1,p2,self); + p1.y := 0; + p1.z := -1; + p2.x := 0; + p2.y := 0; + p2.z := 1; + drawline(p1,p2,self); +end; + +procedure TRot3DFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, PrintBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + PrintBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; +end; + +procedure TRot3DFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TRot3DFrm.FormDestroy(Sender: TObject); +begin + ZScaled := nil; + YScaled := nil; + XScaled := nil; +end; + + +initialization + {$I rot3dunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/smoothdataunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/smoothdataunit.lfm new file mode 100644 index 000000000..ea9b7a912 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/smoothdataunit.lfm @@ -0,0 +1,215 @@ +object DataSmoothingForm: TDataSmoothingForm + Left = 554 + Height = 388 + Top = 284 + Width = 372 + AutoSize = True + Caption = 'Smooth Data' + ClientHeight = 388 + ClientWidth = 372 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 80 + Width = 49 + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + Caption = 'Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = VarInBtn + AnchorSideBottom.Control = RepeatChk + Left = 8 + Height = 211 + Top = 97 + Width = 184 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object VarInBtn: TBitBtn + AnchorSideTop.Control = VarList + AnchorSideRight.Control = SelectedEdit + Left = 200 + Height = 28 + Top = 97 + Width = 28 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = VarInBtnClick + Spacing = 0 + TabOrder = 1 + end + object VarOutBtn: TBitBtn + AnchorSideLeft.Control = VarInBtn + AnchorSideTop.Control = VarInBtn + AnchorSideTop.Side = asrBottom + Left = 200 + Height = 28 + Top = 129 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = VarOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object Label2: TLabel + AnchorSideLeft.Control = SelectedEdit + AnchorSideBottom.Control = SelectedEdit + Left = 236 + Height = 15 + Top = 105 + Width = 47 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Selected:' + ParentColor = False + end + object SelectedEdit: TEdit + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = VarOutBtn + AnchorSideBottom.Side = asrBottom + Left = 236 + Height = 23 + Top = 122 + Width = 128 + Anchors = [akRight, akBottom] + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'SelectedEdit' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 158 + Height = 25 + Top = 355 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Right = 9 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 4 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 221 + Height = 25 + Top = 355 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 305 + Height = 25 + Top = 355 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 6 + end + object RepeatChk: TCheckBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = RepeatEdit + AnchorSideTop.Side = asrCenter + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 19 + Top = 316 + Width = 188 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 4 + Caption = 'Repeat Smoothing No. Times = ' + TabOrder = 7 + end + object RepeatEdit: TEdit + AnchorSideLeft.Control = RepeatChk + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = RepeatChk + AnchorSideTop.Side = asrCenter + Left = 204 + Height = 23 + Top = 314 + Width = 32 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 8 + Text = '1' + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 339 + Width = 372 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 8 + Shape = bsBottomLine + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 60 + Top = 8 + Width = 356 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'This procedure smooths data by averaging every three data points starting with the first three to the last three. The data smoothing can be repeated multiple times. The first and last data points are unchanged.' + ParentColor = False + WordWrap = True + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/smoothdataunit.pas b/applications/lazstats/source/forms/analysis/descriptive/smoothdataunit.pas new file mode 100644 index 000000000..9d01f0b28 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/smoothdataunit.pas @@ -0,0 +1,177 @@ +unit SmoothDataUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, DictionaryUnit; + +type + + { TDataSmoothingForm } + + TDataSmoothingForm = class(TForm) + Bevel1: TBevel; + Memo1: TLabel; + RepeatEdit: TEdit; + RepeatChk: TCheckBox; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + SelectedEdit: TEdit; + Label2: TLabel; + VarInBtn: TBitBtn; + VarOutBtn: TBitBtn; + Label1: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarInBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + procedure VarOutBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + DataSmoothingForm: TDataSmoothingForm; + +implementation + +uses + Math; + +{ TDataSmoothingForm } + +procedure TDataSmoothingForm.ResetBtnClick(Sender: TObject); +var + i : integer; +begin + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + RepeatEdit.Text := '1'; + SelectedEdit.Text := ''; + UpdateBtnStates; +end; + +procedure TDataSmoothingForm.ComputeBtnClick(Sender: TObject); +var + DataPts, OutPts : DblDyneVec; + avalue, avg : double; + N, Reps, i, j, VarCol : integer; + VarLabel, strvalue : string; +begin + N := NoCases; + SetLength(DataPts,N); + SetLength(OutPts,N); + Reps := StrToInt(RepeatEdit.Text); + Varlabel := SelectedEdit.Text; + for i := 1 to NoVariables do + if VarLabel = OS3MainFrm.DataGrid.Cells[i,0] then VarCol := i; + for i := 0 to N - 1 do + begin + avalue := StrToFloat(OS3MainFrm.DataGrid.Cells[VarCol,i+1]); + DataPts[i] := avalue; + end; + + // repeat smoothing for number of times elected + OutPts[0] := DataPts[0]; + OutPts[N-1] := DataPts[N-1]; + for j := 1 to Reps do + begin + for i := 1 to N - 2 do + begin + avg := (DataPts[i-1] + DataPts[i] + DataPts[i+1]) / 3.0; + OutPts[i] := avg; + end; + if j < reps then + for i := 0 to N - 1 do DataPts[i] := OutPts[i]; + end; + // create a new variable and copy smoothed data into it + strvalue := 'Smoothed' + VarLabel; + DictionaryFrm.NewVar(NoVariables+1); + DictionaryFrm.DictGrid.Cells[1,NoVariables] := strvalue; + OS3MainFrm.DataGrid.Cells[NoVariables,0] := strvalue; + for i := 0 to N - 1 do + begin + strvalue := format('%9.3f',[OutPts[i]]); + OS3MainFrm.DataGrid.Cells[NoVariables,i+1] := strvalue; + end; + + // clean up + OutPts := nil; + DataPts := nil; +end; + +procedure TDataSmoothingForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + FAutoSized := True; +end; + +procedure TDataSmoothingForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TDataSmoothingForm.VarInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (SelectedEdit.Text = '') then + begin + SelectedEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TDataSmoothingForm.VarListSelectionChange(Sender: TObject; + User: boolean); +begin + UpdateBtnStates; +end; + +procedure TDataSmoothingForm.VarOutBtnClick(Sender: TObject); +begin + if SelectedEdit.Text <> '' then + begin + VarList.Items.Add(SelectedEdit.Text); + SelectedEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TDataSmoothingForm.UpdateBtnStates; +begin + VarInBtn.Enabled := (VarList.ItemIndex > -1) and (SelectedEdit.Text = ''); + VarOutBtn.Enabled := (SelectedEdit.Text <> ''); +end; + + +initialization + {$I smoothdataunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/stemleafunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/stemleafunit.lfm new file mode 100644 index 000000000..c18b699a7 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/stemleafunit.lfm @@ -0,0 +1,247 @@ +object StemLeafFrm: TStemLeafFrm + Left = 519 + Height = 296 + Top = 257 + Width = 407 + AutoSize = True + Caption = 'Stem and Leaf Analysis' + ClientHeight = 296 + ClientWidth = 407 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object TestChk: TCheckBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 19 + Top = 228 + Width = 202 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 8 + Caption = 'Show All Scaled Values and Srrings' + TabOrder = 0 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = TestChk + Left = 8 + Height = 212 + Top = 8 + Width = 391 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 212 + ClientWidth = 391 + Constraints.MinHeight = 200 + TabOrder = 1 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 100 + Caption = 'Available Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 195 + Top = 17 + Width = 167 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 181 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 181 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = OutBtn + AnchorSideTop.Side = asrBottom + Left = 175 + Height = 25 + Top = 101 + Width = 40 + AutoSize = True + BorderSpacing.Top = 24 + Caption = 'All' + OnClick = AllBtnClick + TabOrder = 3 + end + object Label2: TLabel + AnchorSideLeft.Control = SelectList + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 223 + Height = 15 + Top = 0 + Width = 96 + Caption = 'Selected Variables:' + ParentColor = False + end + object SelectList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 223 + Height = 195 + Top = 17 + Width = 168 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 4 + end + end + object CloseBtn: TButton + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 340 + Height = 25 + Top = 263 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 2 + end + object ComputeBtn: TButton + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 256 + Height = 25 + Top = 263 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 3 + end + object ResetBtn: TButton + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 194 + Height = 25 + Top = 263 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 4 + end + object HelpBtn: TButton + Tag = 148 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 135 + Height = 25 + Top = 263 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 5 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 247 + Width = 407 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/stemleafunit.pas b/applications/lazstats/source/forms/analysis/descriptive/stemleafunit.pas new file mode 100644 index 000000000..814c6116d --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/stemleafunit.pas @@ -0,0 +1,430 @@ +unit StemLeafUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, Math, Clipbrd, + MainUnit, Globals, OutputUnit, DataProcs, ContextHelpUnit; + +type + + { TStemLeafFrm } + + TStemLeafFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + InBtn: TBitBtn; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + Panel1: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + TestChk: TCheckBox; + Label1: TLabel; + Label2: TLabel; + VarList: TListBox; + SelectList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + StemLeafFrm: TStemLeafFrm; + +implementation + +{ TStemLeafFrm } + +procedure TStemLeafFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + SelectList.Clear; + UpdateBtnStates; +end; + +procedure TStemLeafFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TStemLeafFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TStemLeafFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TStemLeafFrm.AllBtnClick(Sender: TObject); +var + i: integer; +begin + for i := 0 to VarList.Items.Count-1 do + SelectList.Items.Add(VarList.Items[i]); + VarList.Clear; + UpdateBtnStates; +end; + +procedure TStemLeafFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, L, ncases, noselected, largest, smallest: integer; + minsize, maxsize, stem, minstem, maxstem, bin, index: integer; + leafvalue, counter, smallcount, testvalue, largestcount: integer; + cellstring, outline, astring: string; + selected: IntDyneVec; + bins: IntDyneVec; + frequency: IntDyneVec; + ValueString: StrDyneVec; + values: DblDyneVec; + leafcount: IntDyneMat; + min, max, temp, X, stemsize: double; + lReport: TStrings; +begin + noselected := SelectList.Items.Count; + if (noselected = 0) then + begin + MessageDlg('No variables were selected.', mtError, [mbOK], 0); + exit; + end; + + SetLength(selected,noselected); + SetLength(values,NoCases); + SetLength(bins,100); + SetLength(frequency,100); + SetLength(ValueString,NoCases); + SetLength(leafcount,100,10); + + // Get selected variables + for i := 1 to noselected do + begin + cellstring := SelectList.Items.Strings[i-1]; + for j := 1 to NoVariables do + if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then selected[i-1] := j; + end; + + lReport := TStringList.Create; + try + lReport.Add('STEM AND LEAF PLOTS'); + lReport.Add(''); + + // Analyze each variable selected + for j := 0 to noselected - 1 do + begin + k := selected[j]; + lReport.Add('Stem and Leaf Plot for variable: %s', [OS3MainFrm.DataGrid.Cells[k,0]]); + ncases := 0; + min := 1.0e308; + max := -1.0e308; + minsize := 1000; + maxsize := -1000; + + // Store values of the variable + for i := 1 to NoCases do + begin + if not ValidValue(i,k) then continue; + values[ncases] := StrToFloat(OS3MainFrm.DataGrid.Cells[k,i]); + ValueString[ncases] := Trim(OS3MainFrm.DataGrid.Cells[k,i]); + if (values[ncases] < min) then min := values[ncases]; + if (values[ncases] > max) then max := values[ncases]; + if Length(ValueString[ncases]) > maxsize then maxsize := Length(ValueString[ncases]); + if Length(ValueString[ncases]) < minsize then minsize := Length(ValueString[ncases]); + ncases := ncases + 1; + end; + + largest := ceil(max); + smallest := ceil(min); + stemsize := 1.0; + if ((largest > 0) and (largest > 10)) then + begin + while (largest > 10)do + begin + largest := largest div 10; + stemsize := stemsize * 10.0; + end; + end else + if ((largest < 0) and (smallest < -10)) then // largest value is less than 0.0 + begin + while (smallest < -10)do + begin + smallest := smallest * 10; + stemsize := stemsize / 10.0; + end; + end; + + // rescale values by stemsize + for i := 0 to ncases - 1 do + values[i] := values[i] / stemsize; + + // multiply values by 10, round and save value divided by 10 + for i := 0 to ncases - 1 do + begin + temp := floor(values[i] * 10); + temp := temp / 10.0; + values[i] := temp; + astring := format('%4.1f',[values[i]]); + ValueString[i] := astring; + end; + + // get max and min stem values for creating bins for stem values + minstem := 999; + maxstem := -999; + for i := 0 to ncases - 1 do + begin + stem := floor(values[i]); + if (stem < minstem) then minstem := stem; + if (stem > maxstem) then maxstem := stem; + end; + + // create arrays for stem and leaf plot + for i := 0 to 19 do + frequency[i] := 0; + + // sort values into ascending order + for i := 0 to ncases-2 do + begin + for k := i+1 to ncases - 1 do + begin + if (values[i] > values[k]) then // swap values + begin + X := values[i]; + values[i] := values[k]; + values[k] := X; + cellstring := ValueString[i]; + ValueString[i] := ValueString[k]; + ValueString[k] := cellstring; + end; + end; + end; +(* + // check sizes - delete if ok + outline := format('maxsize, minsize,stemsize: %10d %10d %10.2f',[maxsize, minsize, stemsize]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; +*) + if TestChk.Checked then + begin // test output + lReport.Add('value ValueString'); + for i := 0 to ncases - 1 do + lReport.Add('%10.1f %s',[values[i],ValueString[i]]); + end; + + lReport.Add(''); + lReport.Add('Frequency Stem & Leaf'); + + // initialize leaf count for the bins + for i := 0 to 99 do // bins + for k := 0 to 9 do leafcount[i,k] := 0; // leafs 0 to 9 + + // count leafs in each bin + for i := 0 to ncases - 1 do + begin + bin := floor(values[i]); // truncate to get stem value + bin := bin - minstem; // get the bin number between 0 and 100 + if (bin < 100) and (bin >= 0) then + begin + bins[bin] := floor(values[i]); + frequency[bin] := frequency[bin] + 1; // count number of stem values + end else + begin + MessageDlg('Error in bin value', mtError, [mbOK], 0); + exit; + end; + + // get leaf value + astring := ValueString[i]; + index := Pos('.',astring); + leafvalue := StrToInt(astring[index+1]); + if (leafvalue < 10) and (leafvalue >= 0) then + leafcount[bin,leafvalue] := leafcount[bin,leafvalue] + 1 + else + begin + MessageDlg('Error in leafvalue', mtError, [mbOK], 0); + exit; + end; + end; + + // get max leaf counters + largestcount := 0; + for i := 0 to 99 do // bin + begin + if frequency[i] = 0 then continue; // skip empty bins + counter := 0; + for k := 0 to 9 do // leaf counts + counter := counter + leafcount[i,k]; + if counter > largestcount then + largestcount := counter; + end; + + // determine leaf depth needed to get counter <= 50 + if (largestcount > 50) then + begin + smallcount := 2; + testvalue := largestcount; + while (testvalue > 50) do + begin + testvalue := largestcount div smallcount; + smallcount := smallcount + 1; + end; + smallcount := smallcount - 1; // leaf depth needed to reduce line lengths to 50 or less + end else + smallcount := 1; + + // rescale leafs + for i := 0 to 99 do // bin + for k := 0 to 9 do // leaf + leafcount[i,k] := leafcount[i,k] div smallcount; + + // plot results + for i := 0 to 99 do + begin + if frequency[i] = 0 then continue; // skip empty bins + outline := format('%6d %3d ',[frequency[i], bins[i]]); + for k := 0 to 9 do + begin + if leafcount[i,k] = 0 then continue; + for L := 1 to leafcount[i,k] do + outline := outline + Format('%d',[k]); + end; + lReport.Add(outline); + end; + + // summarize values + lReport.Add(''); + lReport.Add('Stem Width: %8.3f', [stemSize]); + lReport.Add('Max. Leaf Depth: %8d', [smallcount]); + lReport.Add('Min. Value: %8.3f', [min]); + lReport.Add('Max. Value: %8.3f', [max]); + lReport.Add('No. of good cases: %8d', [ncases]); + lReport.Add(''); + lReport.Add('-------------------------------------------------------------'); + lReport.Add(''); + end; // next jth variable + + DisplayReport(lReport); + + finally + lReport.Free; + frequency := nil; + bins := nil; + ValueString := nil; + values := nil; + selected := nil; + leafcount := nil; + end; +end; + +procedure TStemLeafFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TStemLeafFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + SelectList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TStemLeafFrm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < SelectList.Items.Count do + begin + if SelectList.Selected[i] then + begin + VarList.Items.Add(SelectList.Items[i]); + SelectList.items.Delete(i); + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TStemLeafFrm.UpdateBtnStates; +var + lSelected: Boolean; + i: Integer; +begin + lSelected := false; + for i := 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + InBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to SelectList.Items.Count-1 do + if SelectList.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; +end; + +procedure TStemLeafFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I stemleafunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/descriptive/xvsmultyunit.lfm b/applications/lazstats/source/forms/analysis/descriptive/xvsmultyunit.lfm new file mode 100644 index 000000000..87d92a7ba --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/xvsmultyunit.lfm @@ -0,0 +1,357 @@ +object XvsMultYForm: TXvsMultYForm + Left = 288 + Height = 467 + Top = 117 + Width = 452 + Caption = 'X vs Multiple Y Plot' + ClientHeight = 467 + ClientWidth = 452 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label4: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = PlotTitleEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 332 + Width = 49 + BorderSpacing.Left = 8 + Caption = 'Plot Title:' + ParentColor = False + end + object PlotTitleEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 65 + Height = 23 + Top = 328 + Width = 379 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + TabOrder = 1 + TextHint = 'Title above the chart' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 51 + Top = 359 + Width = 336 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 24 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsScaleChilds + ChildSizing.EnlargeVertical = crsScaleChilds + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 31 + ClientWidth = 332 + TabOrder = 2 + object DescChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 127 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + Caption = 'Descriptive Statistics' + Checked = True + State = cbChecked + TabOrder = 0 + end + object LinesBox: TCheckBox + AnchorSideTop.Side = asrBottom + Left = 163 + Height = 19 + Top = 6 + Width = 157 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + BorderSpacing.Right = 6 + BorderSpacing.Bottom = 6 + Caption = 'Connect Points with Lines' + TabOrder = 1 + end + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = PlotTitleEdit + Left = 8 + Height = 214 + Top = 106 + Width = 436 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 214 + ClientWidth = 436 + Constraints.MinHeight = 200 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 49 + Caption = 'Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = XInBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 197 + Top = 17 + Width = 196 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object XInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 204 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = XInBtnClick + Spacing = 0 + TabOrder = 1 + end + object XOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = XInBtn + AnchorSideTop.Side = asrBottom + Left = 204 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = XOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object YInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Bevel1 + Left = 204 + Height = 28 + Top = 133 + Width = 28 + Anchors = [akLeft, akBottom] + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = YInBtnClick + Spacing = 0 + TabOrder = 4 + end + object YOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + Left = 204 + Height = 28 + Top = 165 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = YOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object Label2: TLabel + AnchorSideLeft.Control = XEdit + AnchorSideBottom.Control = XEdit + Left = 240 + Height = 15 + Top = 25 + Width = 54 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'X Variable:' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = YBox + AnchorSideBottom.Control = YBox + Left = 240 + Height = 15 + Top = 95 + Width = 64 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Y Variable(s)' + ParentColor = False + end + object XEdit: TEdit + AnchorSideLeft.Control = XInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = XOutBtn + AnchorSideBottom.Side = asrBottom + Left = 240 + Height = 23 + Top = 42 + Width = 196 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'XEdit' + end + object YBox: TListBox + AnchorSideLeft.Control = YInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 240 + Height = 102 + Top = 112 + Width = 196 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 6 + end + object Bevel1: TBevel + AnchorSideTop.Control = YBox + AnchorSideTop.Side = asrCenter + Left = 210 + Height = 4 + Top = 161 + Width = 14 + Shape = bsSpacer + end + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 90 + Top = 8 + Width = 436 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Directions: '#13#10'1. Select the X variable common to all of the Y variables to be selected.'#13#10'2. Select the Y variables.'#13#10'3. Enter a label for the plot.'#13#10'4. Select the options desired.'#13#10'5. Click the Compute button to obtain results.' + ParentColor = False + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 385 + Height = 25 + Top = 434 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 297 + Height = 25 + Top = 434 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 235 + Height = 25 + Top = 434 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 418 + Width = 452 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/descriptive/xvsmultyunit.pas b/applications/lazstats/source/forms/analysis/descriptive/xvsmultyunit.pas new file mode 100644 index 000000000..a69b76986 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/descriptive/xvsmultyunit.pas @@ -0,0 +1,449 @@ +// Use file "SchoolsData.laz" for testing + +unit XvsMultYUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, Printers, + MainUnit, Globals, OutputUnit, DataProcs, BlankFrmUnit, MatrixLib; + +type + + { TXvsMultYForm } + + TXvsMultYForm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + LinesBox: TCheckBox; + DescChk: TCheckBox; + GroupBox1: TGroupBox; + Memo1: TLabel; + Panel1: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + PlotTitleEdit: TEdit; + Label4: TLabel; + YBox: TListBox; + XEdit: TEdit; + Label2: TLabel; + Label3: TLabel; + XInBtn: TBitBtn; + YInBtn: TBitBtn; + Label1: TLabel; + XOutBtn: TBitBtn; + YOutBtn: TBitBtn; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + procedure XInBtnClick(Sender: TObject); + procedure XOutBtnClick(Sender: TObject); + procedure YInBtnClick(Sender: TObject); + procedure YOutBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + selected: IntDyneVec; + procedure PlotXY(XValues : DblDyneVec; YValues : DblDyneMat; MaxX, MinX, + MaxY, MinY : double; N, NoY : integer); + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + XvsMultYForm: TXvsMultYForm; + +implementation + +uses + Math; + +{ TXvsMultYForm } + +procedure TXvsMultYForm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + YBox.Clear; + XEdit.Clear; + XInBtn.Enabled := true; + XOutBtn.Enabled := false; + YInBtn.Enabled := true; + YOutBtn.Enabled := false; + PlotTitleEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TXvsMultYForm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TXvsMultYForm.ComputeBtnClick(Sender: TObject); +var + i, j, k, N, NoY, XCol, NoSelected: integer; + YValues, RMatrix: DblDyneMat; + XValues, Means, Variances, StdDevs: DblDyneVec; + MinX, MaxX, MinY, MaxY, temp: double; + Title: string; + RowLabels, ColLabels: StrDyneVec; + lReport: TStrings; + errorcode: boolean = false; + Ncases: integer = 0; +begin + if XEdit.Text = '' then + begin + MessageDlg('No X variable selected.', mtError, [mbOK], 0); + exit; + end; + + if YBox.Items.Count = 0 then + begin + MessageDlg('No Y variables selected.', mtError, [mbOK], 0); + exit; + end; + + NoY := YBox.Items.Count; + MaxX := -10000; + MinX := 10000; + MaxY := -1000; + MinY := 1000; + N := 0; + + SetLength(selected, NoY + 1); + SetLength(RowLabels,NoVariables); + SetLength(ColLabels,NoVariables); + + XCol := 0; + for i := 1 to NoVariables do + if Trim(XEdit.Text) = Trim(OS3MainFrm.DataGrid.Cells[i,0]) then + begin + XCol := i; + break; + end; + + for j := 0 to NoY-1 do + begin + selected[j] := 0; + for i := 1 to NoVariables do + if Trim(YBox.Items.Strings[j]) = Trim(OS3MainFrm.DataGrid.Cells[i,0]) then + begin + selected[j] := i; + Break; + end; + end; + + selected[NoY] := XCol; + NoSelected := NoY + 1; + for i := 0 to NoSelected-1 do + begin + RowLabels[i] := Trim(OS3MainFrm.DataGrid.Cells[selected[i],0]); + ColLabels[i] := RowLabels[i]; + end; + + Caption := RowLabels[0] + ' ' + RowLabels[1]; + + lReport := TStringList.Create; + try + lReport.Add('X VERSUS MULTIPLE Y VALUES PLOT'); + lReport.Add(''); + + SetLength(YValues, NoCases+1, NoY+1); + SetLength(XValues, NoCases+1); + SetLength(Means, NoSelected+1); + SetLength(Variances, NoSelected+1); + SetLength(StdDevs, NoSelected+1); + SetLength(RMatrix, NoSelected+1, NoSelected+1); + SetLength(selected, NoVariables); + + for i := 0 to NoSelected - 1 do + begin + Means[i] := 0.0; + StdDevs[i] := 0.0; + for j := 0 to NoSelected-1 do RMatrix[i,j] := 0.0; + end; + + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,selected) then continue; + XValues[i] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[XCol,i])); + if XValues[i] > MaxX then MaxX := XValues[i]; + if XValues[i] < MinX then MinX := XValues[i]; + for j := 0 to NoY - 1 do + begin + YValues[i-1,j] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[selected[j],i])); + if YValues[i-1,j] > MaxY then MaxY := YValues[i-1,j]; + if YValues[i-1,j] < MinY then MinY := YValues[i-1,j]; + end; + end; + + // get descriptive data + if DescChk.Checked then + begin + Correlations(NoSelected,selected,RMatrix,Means,Variances,StdDevs,errorcode,Ncases); + N := Ncases; + Title := 'CORRELATIONS'; + MatPrint(RMatrix, NoSelected, NoSelected, Title, RowLabels, ColLabels, N, lReport); + Title := 'Means'; + DynVectorPrint(Means, NoSelected, Title, RowLabels, N, lReport); + Title := 'Variances'; + DynVectorPrint(Variances, NoSelected, Title, RowLabels, N, lReport); + Title := 'Standard Deviations'; + DynVectorPrint(StdDevs, NoSelected, Title, RowLabels, N, lReport); + end; + + DisplayReport(lReport); + + // sort on X + for i := 0 to N-2 do + begin + for j := i+1 to N-1 do + begin + if XValues[i] > XValues[j] then // swap + begin + temp := XValues[i]; + XValues[i] := XValues[j]; + XValues[j] := temp; + for k := 0 to NoY-1 do + begin + temp := YValues[i,k]; + YValues[i,k] := YValues[j,k]; + YValues[j,k] := temp; + end; + end; + end; + end; + PlotXY(XValues, YValues, MaxX, MinX, MaxY, MinY, N, NoY); + + finally + lReport.Free; + RMatrix := nil; + StdDevs := nil; + Variances := nil; + Means := nil; + XValues := nil; + YValues := nil; + selected := nil; + ColLabels := nil; + RowLabels := nil; + end; +end; + +procedure TXvsMultYForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TXvsMultYForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + + if BlankFrm = nil then + Application.CreateForm(TBlankFrm, BlankFrm); +end; + +procedure TXvsMultYForm.XInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (XEdit.Text = '') then + begin + XEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TXvsMultYForm.XOutBtnClick(Sender: TObject); +begin + if (XEdit.Text <> '') then + begin + VarList.Items.Add(XEdit.Text); + XEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TXvsMultYForm.YInBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + YBox.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TXvsMultYForm.YOutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < YBox.Items.Count do + begin + if (YBox.Selected[i]) then + begin + VarList.Items.Add(YBox.Items[i]); + YBox.Items.Delete(i); + i := 0; + end else + i := i + 1; + end; + UpdateBtnStates; +end; + +// routine to plot X versus multiple Y values +procedure TXvsMultYForm.PlotXY(XValues: DblDyneVec; YValues: DblDyneMat; + MaxX, MinX, MaxY, MinY: double; N, NoY: integer); +var + i, j, xpos, ypos, hleft, hright, vtop, vbottom, imagewide: integer; + vhi, hwide, offset, strhi, imagehi: integer; + valincr, Yvalue, Xvalue: double; + Title: string; +begin + Title := PlotTitleEdit.Text; + BlankFrm.Caption := Title; + BlankFrm.Show; + + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + vtop := 40; + vbottom := round(imagehi) - 60; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + + // Draw chart border and background + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Rectangle(0, 0, imagewide, imagehi); + + // Draw title + Title := PlotTitleEdit.Text; + if Title <> '' then + begin + xpos := (imagewide - BlankFrm.Image1.Canvas.TextWidth(Title)) div 2; + yPos := 2; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title); + end; + + // draw horizontal axis + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom); + valincr := (maxX - minX) / 10.0; + for i := 1 to 11 do + begin + ypos := vbottom; + Xvalue := minX + valincr * (i - 1); + xpos := hleft + round(hwide * ((Xvalue - minX) / (maxX - minX))); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := Format('%.2f', [Xvalue]); + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + xpos := xpos - offset; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title); + end; + xpos := hleft + (hwide - BlankFrm.Image1.Canvas.TextWidth(XEdit.Text)) div 2; + ypos := vbottom + 30; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, XEdit.Text); + + // draw vertical axis + Title := 'Y VALUES'; + xpos := hleft - BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + ypos := 8; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title); + xpos := hleft; + ypos := vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos, ypos); + ypos := vbottom; + BlankFrm.Image1.Canvas.LineTo(xpos, ypos); + valincr := (maxY - minY) / 10.0; + for i := 1 to 11 do + begin + Title := Format('%.2f',[maxY - ((i-1)*valincr)]); + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := hleft - 20 - BlankFrm.Image1.Canvas.TextWidth(Title); + Yvalue := maxY - (valincr * (i-1)); + ypos := round(vhi * ( (maxY - Yvalue) / (maxY - minY))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title); + xpos := hleft; + ypos := ypos + strhi div 2; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hleft - 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // draw points for x and y pairs + for j := 0 to NoY-1 do + begin + BlankFrm.Image1.Canvas.Brush.Style := bsSolid; + BlankFrm.Image1.Canvas.Brush.Color := DATA_COLORS[j mod Length(DATA_COLORS)]; + BlankFrm.Image1.Canvas.Pen.Color := DATA_COLORS[j mod Length(DATA_COLORS)]; + BlankFrm.Image1.Canvas.Font.Color := DATA_COLORS[j mod Length(DATA_COLORS)]; + Title := Trim(OS3MainFrm.DataGrid.Cells[selected[j],0]); + for i := 1 to N do + begin + ypos := vtop + round(vhi * ( (maxY - YValues[i-1,j]) / (maxY - minY))); + xpos := hleft + round(hwide * ( (XValues[i-1]-minX) / (maxX - minX))); + if xpos < hleft then xpos := hleft; + if i = 1 then + BlankFrm.Image1.Canvas.MoveTo(xpos, ypos); + if LinesBox.Checked then + BlankFrm.Image1.Canvas.LineTo(xpos, ypos); + BlankFrm.Image1.Canvas.Ellipse(xpos, ypos, xpos+5, ypos+5); + end; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + xpos := hwide + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos, ypos-strhi); + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title); + end; + + BlankFrm.Image1.Canvas.Font.Color := clBlack; +end; + +procedure TXvsMultYForm.UpdateBtnStates; +begin +end; + +initialization + {$I xvsmultyunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/financial/dbldeclineunit.lfm b/applications/lazstats/source/forms/analysis/financial/dbldeclineunit.lfm new file mode 100644 index 000000000..5a33fdd7a --- /dev/null +++ b/applications/lazstats/source/forms/analysis/financial/dbldeclineunit.lfm @@ -0,0 +1,254 @@ +object DblDeclineFrm: TDblDeclineFrm + Left = 583 + Height = 216 + Top = 330 + Width = 401 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Double Declining Value' + ClientHeight = 216 + ClientWidth = 401 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ComputeBtn + Left = 174 + Height = 25 + Top = 179 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 2 + end + object ComputeBtn: TButton + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ReturnBtn + Left = 240 + Height = 25 + Top = 179 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 3 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 328 + Height = 25 + Top = 179 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 4 + end + object HelpBtn: TButton + Tag = 118 + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ResetBtn + Left = 111 + Height = 25 + Top = 179 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Right = 12 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 1 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 163 + Width = 401 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 87 + Height = 155 + Top = 8 + Width = 227 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BevelOuter = bvNone + ClientHeight = 155 + ClientWidth = 227 + TabOrder = 0 + object Label1: TLabel + AnchorSideTop.Control = CostEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label5 + AnchorSideRight.Side = asrBottom + Left = 63 + Height = 15 + Top = 4 + Width = 56 + Anchors = [akTop, akRight] + Caption = 'Initial Cost' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = LifeEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label5 + AnchorSideRight.Side = asrBottom + Left = 37 + Height = 15 + Top = 35 + Width = 82 + Anchors = [akTop, akRight] + Caption = 'Life Expectancy' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = EndEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label5 + AnchorSideRight.Side = asrBottom + Left = 68 + Height = 15 + Top = 66 + Width = 51 + Anchors = [akTop, akRight] + Caption = 'End Value' + ParentColor = False + end + object Label4: TLabel + AnchorSideTop.Control = PeriodEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label5 + AnchorSideRight.Side = asrBottom + Left = 15 + Height = 15 + Top = 97 + Width = 104 + Anchors = [akTop, akRight] + Caption = 'Depreciation Period' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = DeprecEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 136 + Width = 119 + Caption = 'Obtained Depreciation' + ParentColor = False + end + object CostEdit: TEdit + AnchorSideLeft.Control = DeprecEdit + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 127 + Height = 23 + Top = 0 + Width = 100 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + Text = 'CostEdit' + end + object LifeEdit: TEdit + AnchorSideLeft.Control = DeprecEdit + AnchorSideTop.Control = CostEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 127 + Height = 23 + Top = 31 + Width = 100 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 1 + Text = 'Edit1' + end + object EndEdit: TEdit + AnchorSideLeft.Control = DeprecEdit + AnchorSideTop.Control = LifeEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 127 + Height = 23 + Top = 62 + Width = 100 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 2 + Text = 'Edit1' + end + object PeriodEdit: TEdit + AnchorSideLeft.Control = DeprecEdit + AnchorSideTop.Control = EndEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 127 + Height = 23 + Top = 93 + Width = 100 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 3 + Text = 'Edit1' + end + object DeprecEdit: TEdit + AnchorSideLeft.Control = Label5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = PeriodEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 127 + Height = 23 + Top = 132 + Width = 100 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + Constraints.MinWidth = 100 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 4 + Text = 'Edit1' + end + end +end diff --git a/applications/lazstats/source/forms/analysis/financial/dbldeclineunit.pas b/applications/lazstats/source/forms/analysis/financial/dbldeclineunit.pas new file mode 100644 index 000000000..8134fc50f --- /dev/null +++ b/applications/lazstats/source/forms/analysis/financial/dbldeclineunit.pas @@ -0,0 +1,219 @@ +unit DblDeclineUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + ContextHelpUnit; + +type + + { TDblDeclineFrm } + + TDblDeclineFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + CostEdit: TEdit; + LifeEdit: TEdit; + EndEdit: TEdit; + PeriodEdit: TEdit; + DeprecEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + function DoubleDecliningBalance(Cost, Salvage: Extended; Life, Period: Integer): Extended; + private + { private declarations } + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + public + { public declarations } + end; + +var + DblDeclineFrm: TDblDeclineFrm; + +implementation + +{ TDblDeclineFrm } + +uses + Math; + +procedure TDblDeclineFrm.ResetBtnClick(Sender: TObject); +begin + CostEdit.Text := ''; + LifeEdit.Text := ''; + EndEdit.Text := ''; + PeriodEdit.Text := ''; + DeprecEdit.Text := ''; +end; + +procedure TDblDeclineFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TDblDeclineFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TDblDeclineFrm.ComputeBtnClick(Sender: TObject); +VAR + Depreciation, Cost, Salvage: Extended; + Life, Period: integer; + msg: String; + C: TWinControl; +begin + if not Validate(msg, C) then + begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + ModalResult := mrNone; + exit; + end; + + Cost := StrToFloat(CostEdit.Text); + Salvage := StrToFloat(EndEdit.Text); + Life := StrToInt(LifeEdit.Text); + Period := StrToInt(PeriodEdit.Text); + Depreciation := DoubleDecliningBalance(Cost, Salvage, Life, Period); + + DeprecEdit.Text := FormatFloat('0.00', Depreciation); +end; + +function TDblDeclineFrm.DoubleDecliningBalance(Cost, Salvage: Extended; Life, Period: Integer): Extended; +{ dv := cost * (1 - 2/life)**(period - 1) + DDB = (2/life) * dv + if DDB > dv - salvage then DDB := dv - salvage + if DDB < 0 then DDB := 0 +} +var + DepreciatedVal, Factor: Extended; +begin + Result := 0; + if (Period < 1) or (Life < Period) or (Life < 1) or (Cost <= Salvage) then + Exit; + + {depreciate everything in period 1 if life is only one or two periods} + if ( Life <= 2 ) then + begin + if ( Period = 1 ) then + DoubleDecliningBalance:=Cost-Salvage + else + DoubleDecliningBalance:=0; {all depreciation occurred in first period} + exit; + end; + Factor := 2.0 / Life; + + DepreciatedVal := Cost * IntPower((1.0 - Factor), Period - 1); + {DepreciatedVal is Cost-(sum of previous depreciation results)} + + Result := Factor * DepreciatedVal; + {Nominal computed depreciation for this period. The rest of the + function applies limits to this nominal value. } + + {Only depreciate until total depreciation equals cost-salvage.} + if Result > DepreciatedVal - Salvage then + Result := DepreciatedVal - Salvage; + + {No more depreciation after salvage value is reached. This is mostly a nit. + If Result is negative at this point, it's very close to zero.} + if Result < 0.0 then + Result := 0.0; +end; + +procedure TDblDeclineFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +function TDblDeclineFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + x: Double; + n: Integer; +begin + Result := false; + + if (CostEdit.Text = '') then + begin + AControl := CostEdit; + AMsg := 'Initial cost not specified.'; + exit; + end; + if not TryStrToFloat(CostEdit.Text, x) then + begin + AControl := CostEdit; + AMsg := 'No valid number for initial cost.'; + exit; + end; + + if (LifeEdit.Text = '') then + begin + AControl := LifeEdit; + AMsg := 'Life expectancy not specified.'; + exit; + end; + if not TryStrToInt(LifeEdit.Text, n) or (n <= 0) then + begin + AControl := LifeEdit; + AMsg := 'Life expectancy can only be a positive number.'; + exit; + end; + + if (EndEdit.Text = '') then + begin + AControl := EndEdit; + AMsg := 'End value not specified.'; + exit; + end; + if not TryStrToFloat(EndEdit.Text, x) then + begin + AControl := EndEdit; + AMsg := 'No valid number given for end value.'; + exit; + end; + + if (PeriodEdit.Text = '') then + begin + AControl := PeriodEdit; + AMsg := 'Depreciation period not specified.'; + exit; + end; + if not TryStrToInt(PeriodEdit.Text, n) or (n <= 0) then + begin + AControl := PeriodEdit; + AMsg := 'Depreciation period can only be a positive number.'; + exit; + end; + + Result := true; +end; + +initialization + {$I dbldeclineunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/financial/loanitunit.lfm b/applications/lazstats/source/forms/analysis/financial/loanitunit.lfm new file mode 100644 index 000000000..501df164e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/financial/loanitunit.lfm @@ -0,0 +1,385 @@ +object LoanItFrm: TLoanItFrm + Left = 310 + Height = 393 + Top = 131 + Width = 353 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Loan Calculation and Amortization' + ClientHeight = 393 + ClientWidth = 353 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideTop.Control = AmountEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label2 + AnchorSideRight.Side = asrBottom + Left = 95 + Height = 15 + Top = 105 + Width = 93 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Principal Amount' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = InterestEdit + AnchorSideTop.Side = asrCenter + Left = 16 + Height = 15 + Top = 144 + Width = 172 + BorderSpacing.Left = 16 + Caption = 'Annual Percentage Rate (APR %)' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = YearsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label2 + AnchorSideRight.Side = asrBottom + Left = 100 + Height = 15 + Top = 171 + Width = 88 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Number of years' + ParentColor = False + end + object Label4: TLabel + AnchorSideTop.Control = PayPerYrEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label2 + AnchorSideRight.Side = asrBottom + Left = 30 + Height = 15 + Top = 198 + Width = 158 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Number of Payments Per Year' + ParentColor = False + end + object Label5: TLabel + AnchorSideTop.Control = RePayEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label2 + AnchorSideRight.Side = asrBottom + Left = 141 + Height = 15 + Top = 237 + Width = 47 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Payment' + ParentColor = False + end + object Label6: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = NameEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 12 + Width = 65 + BorderSpacing.Left = 8 + Caption = 'Your Name: ' + ParentColor = False + end + object AmountEdit: TEdit + AnchorSideLeft.Control = InterestEdit + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + Left = 196 + Height = 23 + Top = 101 + Width = 149 + Alignment = taRightJustify + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + TabOrder = 3 + Text = 'AmountEdit' + end + object InterestEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = AmountEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 196 + Height = 23 + Top = 140 + Width = 149 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + TabOrder = 4 + Text = 'InterestEdit' + end + object YearsEdit: TEdit + AnchorSideLeft.Control = InterestEdit + AnchorSideTop.Control = InterestEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InterestEdit + AnchorSideRight.Side = asrBottom + Left = 196 + Height = 23 + Top = 167 + Width = 149 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 5 + Text = 'YearsEdit' + end + object PayPerYrEdit: TEdit + AnchorSideLeft.Control = InterestEdit + AnchorSideTop.Control = YearsEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InterestEdit + AnchorSideRight.Side = asrBottom + Left = 196 + Height = 23 + Top = 194 + Width = 149 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 6 + Text = 'PayPerYrEdit' + end + object RePayEdit: TEdit + AnchorSideLeft.Control = InterestEdit + AnchorSideTop.Control = PayPerYrEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AmountEdit + AnchorSideRight.Side = asrBottom + Left = 196 + Height = 23 + Top = 233 + Width = 149 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 16 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 7 + Text = 'RePayEdit' + end + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AmortizeBtn + Left = 138 + Height = 25 + Top = 315 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 9 + end + object AmortizeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 200 + Height = 25 + Top = 315 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = AmortizeBtnClick + TabOrder = 10 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 284 + Height = 25 + Top = 315 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 11 + end + object NameEdit: TEdit + AnchorSideLeft.Control = Label6 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 81 + Height = 23 + Top = 8 + Width = 264 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 0 + Text = 'NameEdit' + end + object PrintChk: TCheckBox + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = RePayEdit + AnchorSideTop.Side = asrBottom + Left = 82 + Height = 19 + Top = 272 + Width = 188 + BorderSpacing.Top = 16 + Caption = 'Print the Amortization Schedule' + TabOrder = 8 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = PrintChk + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 299 + Width = 353 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + Shape = bsBottomLine + end + object CalendarBtn: TButton + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NameEdit + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 310 + Height = 25 + Top = 60 + Width = 35 + Anchors = [akRight, akBottom] + AutoSize = True + Caption = '...' + OnClick = CalendarBtnClick + TabOrder = 2 + end + object Panel1: TPanel + AnchorSideTop.Control = NameEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CalendarBtn + Left = 16 + Height = 42 + Top = 43 + Width = 282 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 12 + BorderSpacing.Right = 12 + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 12 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsScaleChilds + ChildSizing.ShrinkHorizontal = crsHomogenousChildResize + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 3 + ClientHeight = 42 + ClientWidth = 282 + TabOrder = 1 + object Label7: TLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 15 + Top = 0 + Width = 98 + Caption = 'Current Month No' + ParentColor = False + end + object Label8: TLabel + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 110 + Height = 15 + Top = 0 + Width = 80 + Caption = 'Day of Month' + ParentColor = False + end + object Label9: TLabel + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 202 + Height = 15 + Top = 0 + Width = 80 + Caption = 'Current Year' + ParentColor = False + end + object MonthEdit: TEdit + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 23 + Top = 19 + Width = 98 + Alignment = taRightJustify + BorderSpacing.Top = 2 + TabOrder = 0 + Text = 'MonthEdit' + end + object DayEdit: TEdit + AnchorSideRight.Side = asrBottom + Left = 110 + Height = 23 + Top = 19 + Width = 80 + Alignment = taRightJustify + TabOrder = 1 + Text = 'DayEdit' + end + object YearEdit: TEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 202 + Height = 23 + Top = 19 + Width = 80 + Alignment = taRightJustify + BorderSpacing.Top = 4 + TabOrder = 2 + Text = 'YearEdit' + end + end + object CalendarDialog1: TCalendarDialog + Date = 43890 + OKCaption = '&OK' + CancelCaption = 'Cancel' + left = 48 + top = 312 + end +end diff --git a/applications/lazstats/source/forms/analysis/financial/loanitunit.pas b/applications/lazstats/source/forms/analysis/financial/loanitunit.pas new file mode 100644 index 000000000..8e3ae7556 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/financial/loanitunit.pas @@ -0,0 +1,328 @@ +unit LoanItUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, ExtDlgs; + +type + + { TLoanItFrm } + + TLoanItFrm = class(TForm) + Bevel1: TBevel; + CalendarBtn: TButton; + CalendarDialog1: TCalendarDialog; + Panel1: TPanel; + PrintChk: TCheckBox; + DayEdit: TEdit; + YearEdit: TEdit; + MonthEdit: TEdit; + Label7: TLabel; + Label8: TLabel; + Label9: TLabel; + NameEdit: TEdit; + Label6: TLabel; + ResetBtn: TButton; + AmortizeBtn: TButton; + ReturnBtn: TButton; + AmountEdit: TEdit; + InterestEdit: TEdit; + YearsEdit: TEdit; + PayPerYrEdit: TEdit; + RePayEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + procedure AmortizeBtnClick(Sender: TObject); + procedure CalendarBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure Heading(AReport: TStrings); + private + { private declarations } + function Validate(out AMsg: String; out AControl: TWinControl): boolean; + public + { public declarations } + end; + +var + LoanItFrm: TLoanItFrm; + +implementation + +uses + Math, DateUtils, OutputUnit; + +{ TLoanItFrm } + +procedure TLoanItFrm.ResetBtnClick(Sender: TObject); +begin + NameEdit.Text := ''; + MonthEdit.Text := ''; + DayEdit.Text := ''; + YearEdit.Text := ''; + YearsEdit.Text := '30'; + AmountEdit.Text := '10000'; + InterestEdit.Text := '6.5'; + PayPerYrEdit.Text := '12'; + RepayEdit.Text := ''; +end; + +procedure TLoanItFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TLoanItFrm.AmortizeBtnClick(Sender: TObject); +VAR + no_per_year, year_payed, month_payed, day, month, j, k : integer; + fraction, interest, numerator, denominator, payment, total_interest : double; + amount, interest_payment, total_payed, pcnt_interest, years, no_years : double; + aname: string; + msg: String; + C: TWinControl; + lReport: TStrings; +begin + if not Validate(msg, C) then begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOk], 0); + ModalResult := mrNone; + exit; + end; + + aname := NameEdit.Text; + no_per_year := StrToInt(PayPerYrEdit.Text); + day := StrToInt(DayEdit.Text); + month := StrToInt(MonthEdit.Text); + years := StrToFloat(YearEdit.Text); + amount := StrToFloat(AmountEdit.Text); + no_years := StrToFloat(YearsEdit.Text); + pcnt_interest := StrToFloat(InterestEdit.Text); + + interest := pcnt_interest / 100.0; + numerator := interest * amount / no_per_year ; + denominator := 1.0 - (1.0 / power((interest / no_per_year + 1.0), + (no_per_year * no_years) ) ); + payment := numerator / denominator; + RePayEdit.Text := Format('%10.2f', [payment]); + + if not PrintChk.Checked then + exit; + + if (no_per_year < 12) then + fraction := 12.0 / no_per_year else fraction := 1.0; + + lReport := TStringList.Create; + try + lReport.Add('Payment Schedule Program by W. G. Miller'); + lReport.Add(''); + lReport.Add('----------------------------------------------------------------------------'); + lReport.Add(''); + lReport.Add('Name of Borrower: ' + aname); + lReport.Add('Amount borrowed: $%.2f at %.2f percent over %.1f years.', [amount, pcnt_interest, no_years]); + lReport.Add(''); + total_interest := 0.0; + total_payed := 0.0; + for j := 1 to round(no_years) do + begin + Heading(lReport); + for k := 1 to no_per_year do + begin + year_payed := round(years) + j - 1 ; + month_payed := round(k * fraction + (month - fraction)); + if (month_payed > 12) then + begin + year_payed := year_payed + 1; + month_payed := month_payed - 12; + end; + interest_payment := amount * interest / no_per_year; + amount := amount - payment + interest_payment; + total_interest := total_interest + interest_payment; + total_payed := total_payed + payment; + lReport.Add(' %2d/%2d/%2d %12.2f %12.2f %12.2f %12.2f %12.2f', [ + month_payed, day, year_payed, payment, interest_payment, + amount, total_interest, total_payed + ]); + end; // next k + lReport.Add(''); + //lReport.Add('----------------------------------------------------------------------------'); + end; // next j + + DisplayReport(lReport); + + finally + lReport.Free; + end; +end; + +procedure TLoanItFrm.CalendarBtnClick(Sender: TObject); +var + d: TDate; + dy, mn, yr: Integer; + ok: Boolean; +begin + ok := (DayEdit.Text <> '') and TryStrToInt(DayEdit.Text, dy) and + (MonthEdit.Text <> '') and TryStrToInt(MonthEdit.Text, mn) and + (YearEdit.Text <> '') and TryStrToInt(YearEdit.Text, yr) and + TryEncodeDate(yr, mn, dy, d); + if not ok then + d := Date; + CalendarDialog1.Date := d; + if CalendarDialog1.Execute then + begin + YearEdit.Text := IntToStr(YearOf(CalendarDialog1.Date)); + MonthEdit.Text := IntToStr(MonthOf(CalendarDialog1.Date)); + DayEdit.Text := IntToStr(DayOf(CalendarDialog1.Date)); + end; +end; + +procedure TLoanItFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, AmortizeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + AmortizeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + { + w := DayEdit.Width; + DayEdit.Constraints.MaxWidth := w; + MonthEdit.Constraints.MaxWidth := w; + YearEdit.Constraints.MaxWidth := w; + } +end; + +procedure TLoanItFrm.Heading(AReport: TStrings); +begin + AReport.Add('----------------------------------------------------------------------------'); + AReport.Add('PAYMENT PAYMENT INTEREST BALANCE TOTAL TOTAL'); + AReport.Add('NUMBER AMOUNT PAYED REMAINING INTEREST PAID'); + AReport.Add('----------------------------------------------------------------------------'); +end; + +function TLoanItFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + n: Integer; + x: Double; +begin + Result := False; + + if MonthEdit.Text = '' then + begin + AControl := MonthEdit; + AMsg := 'This field cannot be empty.'; + exit; + end; + if not TryStrToInt(MonthEdit.Text, n) then + begin + AControl := MonthEdit; + AMsg := 'No valid integer in this field.'; + exit; + end; + + if DayEdit.Text = '' then + begin + AControl := DayEdit; + AMsg := 'This field cannot be empty.'; + exit; + end; + if not TryStrToInt(DayEdit.Text, n) then + begin + AControl := DayEdit; + AMsg := 'No valid integer in this field.'; + exit; + end; + + if YearEdit.Text = '' then + begin + AControl := YearEdit; + AMsg := 'This field cannot be empty.'; + exit; + end; + if not TryStrToInt(YearEdit.Text, n) then + begin + AControl := YearEdit; + AMsg := 'No valid integer in this field.'; + exit; + end; + + if AmountEdit.Text = '' then + begin + AControl := AmountEdit; + AMsg := 'This field cannot be empty'; + exit; + end; + if not TryStrToFloat(AmountEdit.Text, x) then + begin + AControl := AmountEdit; + AMsg := 'No valid number in this field.'; + exit; + end; + + if YearsEdit.Text = '' then + begin + AControl := YearsEdit; + AMsg := 'This field cannot be empty.'; + exit; + end; + if not TryStrToFloat(YearsEdit.Text, x) then + begin + AControl := YearsEdit; + AMsg := 'No valid number in this field.'; + exit; + end; + if n <= 0 then + begin + AControl := YearsEdit; + AMsg := 'Number of years must be positive.'; + exit; + end; + + if PayPerYrEdit.Text = '' then + begin + AControl := PayPerYrEdit; + AMsg := 'Payments per year not specified.'; + exit; + end; + if not TryStrToInt(PayPerYrEdit.Text, n) then + begin + AControl := PayPerYrEdit; + AMsg := 'No valid integer in this field.'; + exit; + end; + if n <= 0 then + begin + AControl := PayPerYrEdit; + AMsg := 'Payments per year must not be zero or negative.'; + exit; + end; + + if InterestEdit.Text = '' then + begin + AControl := InterestEdit; + AMsg := 'Interest rate not specified.'; + exit; + end; + if not TryStrToFloat(InterestEdit.Text, x) then + begin + AControl := InterestEdit; + AMsg := 'No valid number given as interest rate.'; + exit; + end; + + Result := true; +end; + +initialization + + {$I loanitunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/financial/sldunit.lfm b/applications/lazstats/source/forms/analysis/financial/sldunit.lfm new file mode 100644 index 000000000..9f4d82b06 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/financial/sldunit.lfm @@ -0,0 +1,221 @@ +object SLDepFrm: TSLDepFrm + Left = 685 + Height = 206 + Top = 433 + Width = 315 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Straight Line Depreciation' + ClientHeight = 206 + ClientWidth = 315 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideTop.Control = CostEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label4 + AnchorSideRight.Side = asrBottom + Left = 134 + Height = 15 + Top = 12 + Width = 56 + Anchors = [akTop, akRight] + Caption = 'Initial Cost' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = SalvageEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label4 + AnchorSideRight.Side = asrBottom + Left = 44 + Height = 15 + Top = 74 + Width = 146 + Anchors = [akTop, akRight] + Caption = 'Salvage Value at End of Life:' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = PeriodsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label4 + AnchorSideRight.Side = asrBottom + Left = 25 + Height = 15 + Top = 43 + Width = 165 + Anchors = [akTop, akRight] + Caption = 'No. of Periods of Life Expected:' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = DepreciationEdit + AnchorSideTop.Side = asrCenter + Left = 24 + Height = 15 + Top = 113 + Width = 166 + BorderSpacing.Left = 24 + Caption = 'Depreciation Allowed (Answer):' + ParentColor = False + end + object CostEdit: TEdit + AnchorSideLeft.Control = DepreciationEdit + AnchorSideTop.Control = Owner + AnchorSideRight.Control = DepreciationEdit + AnchorSideRight.Side = asrBottom + Left = 206 + Height = 23 + Top = 8 + Width = 101 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 0 + Text = 'CostEdit' + end + object SalvageEdit: TEdit + AnchorSideLeft.Control = DepreciationEdit + AnchorSideTop.Control = PeriodsEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepreciationEdit + AnchorSideRight.Side = asrBottom + Left = 206 + Height = 23 + Top = 70 + Width = 101 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 2 + Text = 'Edit1' + end + object PeriodsEdit: TEdit + AnchorSideLeft.Control = DepreciationEdit + AnchorSideTop.Control = CostEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepreciationEdit + AnchorSideRight.Side = asrBottom + Left = 206 + Height = 23 + Top = 39 + Width = 101 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 1 + Text = 'Edit1' + end + object DepreciationEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SalvageEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 206 + Height = 23 + Top = 109 + Width = 101 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 3 + Text = 'Edit1' + end + object ResetBtn: TButton + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 100 + Height = 25 + Top = 156 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object ComputeBtn: TButton + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 162 + Height = 25 + Top = 156 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 246 + Height = 25 + Top = 156 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 7 + end + object HelpBtn: TButton + Tag = 146 + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 41 + Height = 25 + Top = 156 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 7 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 4 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = DepreciationEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 140 + Width = 315 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/financial/sldunit.pas b/applications/lazstats/source/forms/analysis/financial/sldunit.pas new file mode 100644 index 000000000..606f1729b --- /dev/null +++ b/applications/lazstats/source/forms/analysis/financial/sldunit.pas @@ -0,0 +1,169 @@ +unit SLDUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + ContextHelpUnit; + +type + + { TSLDepFrm } + + TSLDepFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + ResetBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + CostEdit: TEdit; + SalvageEdit: TEdit; + PeriodsEdit: TEdit; + DepreciationEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + function SLNDepreciation(Cost, Salvage: Extended; Life: Integer): Extended; + private + { private declarations } + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + public + { public declarations } + end; + +var + SLDepFrm: TSLDepFrm; + +implementation + +uses + Math; + +{ TSLDepFrm } + +procedure TSLDepFrm.ResetBtnClick(Sender: TObject); +begin + CostEdit.Text := ''; + SalvageEdit.Text := ''; + PeriodsEdit.Text := ''; + DepreciationEdit.Text := ''; +end; + +procedure TSLDepFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TSLDepFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.Createform(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TSLDepFrm.ComputeBtnClick(Sender: TObject); +var + Cost, Depr, Salvage: Extended; + Life: integer; + msg: String; + C: TWinControl; +begin + if not Validate(msg, C) then begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + ModalResult := mrNone; + exit; + end; + + // Obtain results + Cost := StrToFloat(CostEdit.Text); + Salvage := StrToFloat(SalvageEdit.Text); + Life := StrToInt(PeriodsEdit.Text); + if Life < 1 then + MessageDlg('Life is less than 1.', mtError, [mbOK], 0) + else + begin + Depr := SLNDepreciation(Cost, Salvage, Life); + DepreciationEdit.Text := FormatFloat('0.00', Depr); + end; +end; + +procedure TSLDepFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, HelpBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + HelpBtn.Constraints.MinWidth := w; +end; + +{ Spreads depreciation linearly over life. } +function TSLDepFrm.SLNDepreciation(Cost, Salvage: Extended; Life: Integer): Extended; +begin + Result := (Cost - Salvage) / Life +end; + +function TSLDepFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + x: Double; + n: Integer; +begin + Result := false; + + if CostEdit.Text = '' then + begin + AControl := CostEdit; + AMsg := 'Initial cost cannot be empty.'; + exit; + end; + if not TryStrToFloat(CostEdit.Text, x) then + begin + AControl := CostEdit; + AMsg := 'No valid number given as initial cost.'; + exit; + end; + + if PeriodsEdit.Text = '' then + begin + AControl := PeriodsEdit; + AMsg := 'Number of periodes cannot be empty.'; + exit; + end; + if (not TryStrToInt(PeriodsEdit.Text, n)) or (n <= 0) then + begin + AControl := PeriodsEdit; + AMsg := 'The number of periods must not be zero or negative.'; + exit; + end; + + if SalvageEdit.Text = '' then + begin + AControl := SalvageEdit; + AMsg := 'Savage value cannot be empty.'; + exit; + end; + if not TryStrToFloat(SalvageEdit.Text, x) then + begin + AControl := SalvageEdit; + AMsg := 'No valid number given as salvage value.'; + exit; + end; + + Result := true; +end; + +initialization + {$I sldunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/financial/sumyrsdepunit.lfm b/applications/lazstats/source/forms/analysis/financial/sumyrsdepunit.lfm new file mode 100644 index 000000000..5fd29680d --- /dev/null +++ b/applications/lazstats/source/forms/analysis/financial/sumyrsdepunit.lfm @@ -0,0 +1,244 @@ +object SumYrsDepFrm: TSumYrsDepFrm + Left = 461 + Height = 231 + Top = 241 + Width = 291 + AutoSize = True + BorderStyle = bsSingle + Caption = 'Sum of Years Depreciation' + ClientHeight = 231 + ClientWidth = 291 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideTop.Control = CostEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label3 + AnchorSideRight.Side = asrBottom + Left = 133 + Height = 15 + Top = 12 + Width = 62 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Initial Cost: ' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = SalvageEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label3 + AnchorSideRight.Side = asrBottom + Left = 52 + Height = 15 + Top = 43 + Width = 143 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Salvage value at end of life:' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = LifeEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 74 + Width = 187 + BorderSpacing.Left = 8 + Caption = 'Number of Periods of life Expected:' + ParentColor = False + end + object Label4: TLabel + AnchorSideTop.Control = PeriodEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label3 + AnchorSideRight.Side = asrBottom + Left = 50 + Height = 15 + Top = 105 + Width = 145 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Period for the Depreciation:' + ParentColor = False + end + object Label5: TLabel + AnchorSideTop.Control = DepreciationEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label3 + AnchorSideRight.Side = asrBottom + Left = 17 + Height = 15 + Top = 144 + Width = 178 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Depreciation Allowance (Answer):' + ParentColor = False + end + object CostEdit: TEdit + AnchorSideLeft.Control = LifeEdit + AnchorSideTop.Control = Owner + AnchorSideRight.Control = LifeEdit + AnchorSideRight.Side = asrBottom + Left = 203 + Height = 23 + Top = 8 + Width = 80 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 0 + Text = 'CostEdit' + end + object SalvageEdit: TEdit + AnchorSideLeft.Control = LifeEdit + AnchorSideTop.Control = CostEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = LifeEdit + AnchorSideRight.Side = asrBottom + Left = 203 + Height = 23 + Top = 39 + Width = 80 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 1 + Text = 'Edit1' + end + object LifeEdit: TEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SalvageEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 203 + Height = 23 + Top = 70 + Width = 80 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 2 + Text = 'Edit1' + end + object PeriodEdit: TEdit + AnchorSideLeft.Control = LifeEdit + AnchorSideTop.Control = LifeEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = LifeEdit + AnchorSideRight.Side = asrBottom + Left = 203 + Height = 23 + Top = 101 + Width = 80 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 3 + Text = 'Edit1' + end + object DepreciationEdit: TEdit + AnchorSideLeft.Control = LifeEdit + AnchorSideTop.Control = PeriodEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = LifeEdit + AnchorSideRight.Side = asrBottom + Left = 203 + Height = 23 + Top = 140 + Width = 80 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 16 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 4 + Text = 'Edit1' + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 218 + Height = 25 + Top = 179 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 5 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = DepreciationEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 163 + Width = 291 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object ComputeBtn: TButton + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ReturnBtn + Left = 134 + Height = 25 + Top = 179 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end + object ResetBtn: TButton + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ComputeBtn + Left = 72 + Height = 25 + Top = 179 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 7 + end + object HelpBtn: TButton + Tag = 149 + AnchorSideTop.Control = ResetBtn + AnchorSideRight.Control = ResetBtn + Left = 13 + Height = 25 + Top = 179 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Right = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 8 + end +end diff --git a/applications/lazstats/source/forms/analysis/financial/sumyrsdepunit.pas b/applications/lazstats/source/forms/analysis/financial/sumyrsdepunit.pas new file mode 100644 index 000000000..30a1c7734 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/financial/sumyrsdepunit.pas @@ -0,0 +1,192 @@ +unit SumYrsDepUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Math, ContextHelpUnit; + +type + + { TSumYrsDepFrm } + + TSumYrsDepFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + ResetBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + CostEdit: TEdit; + SalvageEdit: TEdit; + LifeEdit: TEdit; + PeriodEdit: TEdit; + DepreciationEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + function SYDDepreciation(Cost, Salvage: Extended; Life, Period: Integer): Extended; + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + public + { public declarations } + end; + +var + SumYrsDepFrm: TSumYrsDepFrm; + +implementation + +{ TSumYrsDepFrm } + +procedure TSumYrsDepFrm.ResetBtnClick(Sender: TObject); +begin + CostEdit.Text := ''; + SalvageEdit.Text := ''; + LifeEdit.Text := ''; + DepreciationEdit.Text := ''; + PeriodEdit.Text := ''; +end; + +procedure TSumYrsDepFrm.ComputeBtnClick(Sender: TObject); +VAR + Cost, Depreciation, Salvage: Extended; + Life, Period: integer; + msg: String; + C: TWinControl; +begin + if not Validate(msg, C) then begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + ModalResult := mrNone; + exit; + end; + + Cost := StrToFloat(CostEdit.Text); + Salvage := StrToFloat(SalvageEdit.Text); + Life := StrToInt(LifeEdit.Text); + Period := StrToInt(PeriodEdit.Text); + Depreciation := SYDDepreciation(Cost, Salvage, Life, Period); + + DepreciationEdit.Text := FormatFloat('0.00', Depreciation); +end; + +procedure TSumYrsDepFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + Constraints.MinHeight := Height; + Constraints.MaxHeight := Height; + Constraints.MinWidth := Width; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure TSumYrsDepFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TSumYrsDepFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +function TSumYrsDepFrm.SYDDepreciation(Cost, Salvage: Extended; Life, Period: Integer): Extended; +{ SYD = (cost - salvage) * (life - period + 1) / (life*(life + 1)/2) } +{ Note: life*(life+1)/2 = 1+2+3+...+life "sum of years" + The depreciation factor varies from life/sum_of_years in first period = 1 + downto 1/sum_of_years in last period = life. + Total depreciation over life is cost-salvage.} +var + X1, X2: Extended; +begin + Result := 0; + if (Period < 1) or (Life < Period) or (Cost <= Salvage) then Exit; + X1 := 2 * (Life - Period + 1); + X2 := Life * (Life + 1); + Result := (Cost - Salvage) * X1 / X2 +end; + +function TSumYrsDepFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + x: Double; + n: Integer; +begin + Result := false; + + if (CostEdit.Text = '') then + begin + AControl := CostEdit; + AMsg := 'Initial cost not specified.'; + exit; + end; + if not TryStrToFloat(CostEdit.Text, x) then + begin + AControl := CostEdit; + AMsg := 'No valid number for initial cost.'; + exit; + end; + + if (LifeEdit.Text = '') then + begin + AControl := LifeEdit; + AMsg := 'Life expectancy not specified.'; + exit; + end; + if not TryStrToInt(LifeEdit.Text, n) or (n <= 0) then + begin + AControl := LifeEdit; + AMsg := 'Life expectancy can only be a positive number.'; + exit; + end; + + if (SalvageEdit.Text = '') then + begin + AControl := SalvageEdit; + AMsg := 'Salvage value not specified.'; + exit; + end; + if not TryStrToFloat(SalvageEdit.Text, x) then + begin + AControl := SalvageEdit; + AMsg := 'No valid number given for salvage value.'; + exit; + end; + + if (PeriodEdit.Text = '') then + begin + AControl := PeriodEdit; + AMsg := 'Depreciation period not specified.'; + exit; + end; + if not TryStrToInt(PeriodEdit.Text, n) or (n <= 0) then + begin + AControl := PeriodEdit; + AMsg := 'Depreciation period can only be a positive number.'; + exit; + end; + + Result := true; +end; + +initialization + {$I sumyrsdepunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/matrix_manipulation/colinsertunit.lfm b/applications/lazstats/source/forms/analysis/matrix_manipulation/colinsertunit.lfm new file mode 100644 index 000000000..92f0b0aa3 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/matrix_manipulation/colinsertunit.lfm @@ -0,0 +1,152 @@ +object ColInsertFrm: TColInsertFrm + Left = 710 + Height = 149 + Top = 385 + Width = 291 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Column Insert' + ClientHeight = 149 + ClientWidth = 291 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideTop.Control = GridNoEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = GridNoEdit + Left = 49 + Height = 15 + Top = 12 + Width = 165 + Anchors = [akTop, akRight] + BorderSpacing.Left = 24 + BorderSpacing.Right = 8 + Caption = 'Insert a column in which grid ? ' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = BeforeColEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = BeforeColEdit + Left = 93 + Height = 15 + Top = 43 + Width = 121 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Insert Before Column : ' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = AfterColEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = AfterColEdit + Left = 101 + Height = 15 + Top = 74 + Width = 113 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Insert After Column : ' + ParentColor = False + end + object GridNoEdit: TEdit + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 222 + Height = 23 + Top = 8 + Width = 45 + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 24 + TabOrder = 0 + Text = 'GridNoEdit' + end + object BeforeColEdit: TEdit + AnchorSideLeft.Control = GridNoEdit + AnchorSideTop.Control = GridNoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GridNoEdit + AnchorSideRight.Side = asrBottom + Left = 222 + Height = 23 + Top = 39 + Width = 45 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 1 + Text = 'Edit1' + end + object AfterColEdit: TEdit + AnchorSideLeft.Control = GridNoEdit + AnchorSideTop.Control = BeforeColEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GridNoEdit + AnchorSideRight.Side = asrBottom + Left = 222 + Height = 23 + Top = 70 + Width = 45 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 2 + Text = 'Edit1' + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Side = asrBottom + Left = 144 + Height = 25 + Top = 113 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 3 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 218 + Height = 25 + Top = 113 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 4 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = AfterColEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 97 + Width = 291 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/matrix_manipulation/colinsertunit.pas b/applications/lazstats/source/forms/analysis/matrix_manipulation/colinsertunit.pas new file mode 100644 index 000000000..d2ca684bd --- /dev/null +++ b/applications/lazstats/source/forms/analysis/matrix_manipulation/colinsertunit.pas @@ -0,0 +1,70 @@ +unit ColInsertUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls; + +type + + { TColInsertFrm } + + TColInsertFrm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + ReturnBtn: TButton; + GridNoEdit: TEdit; + BeforeColEdit: TEdit; + AfterColEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + ColInsertFrm: TColInsertFrm; + +implementation + +uses + Math, MatManUnit; + +{ TColInsertFrm } + +procedure TColInsertFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([CancelBtn.Width, ReturnBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure TColInsertFrm.FormCreate(Sender: TObject); +begin + if MatManFrm = nil then + Application.CreateForm(TMatManFrm, MatManFrm); +end; + +procedure TColInsertFrm.FormShow(Sender: TObject); +begin + AfterColEdit.Text := ''; + BeforeColEdit.Text := ''; + GridNoEdit.Text := matmanfrm.GridNoEdit.Text; +end; + +initialization + {$I colinsertunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/matrix_manipulation/matmanunit.lfm b/applications/lazstats/source/forms/analysis/matrix_manipulation/matmanunit.lfm new file mode 100644 index 000000000..8bac64e0c --- /dev/null +++ b/applications/lazstats/source/forms/analysis/matrix_manipulation/matmanunit.lfm @@ -0,0 +1,793 @@ +object MatManFrm: TMatManFrm + Left = 347 + Height = 575 + Top = 176 + Width = 943 + Caption = 'Matrix Manipulation' + ClientHeight = 555 + ClientWidth = 943 + Menu = MainMenu1 + OnCreate = FormCreate + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Label2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = GridNoEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 12 + Width = 107 + BorderSpacing.Left = 8 + Caption = 'Current Active Grid: ' + ParentColor = False + end + object GridNoEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + Left = 123 + Height = 23 + Top = 8 + Width = 59 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 0 + Text = 'GridNoEdit' + end + object Op1Edit: TEdit + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 25 + Height = 23 + Top = 524 + Width = 186 + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + TabOrder = 1 + Text = 'Op1Edit' + end + object Op2Edit: TEdit + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 224 + Height = 23 + Top = 524 + Width = 186 + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + TabOrder = 2 + Text = 'Edit1' + end + object Op3Edit: TEdit + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 424 + Height = 23 + Top = 524 + Width = 186 + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + TabOrder = 3 + Text = 'Edit1' + end + object Op4Edit: TEdit + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 624 + Height = 23 + Top = 524 + Width = 186 + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + TabOrder = 4 + Text = 'Edit1' + end + object Panel5: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = GridNoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Splitter1 + AnchorSideBottom.Control = Op1Edit + Left = 8 + Height = 477 + Top = 39 + Width = 724 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 12 + ChildSizing.VerticalSpacing = 12 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsHomogenousChildResize + ChildSizing.ShrinkVertical = crsHomogenousChildResize + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 2 + ClientHeight = 477 + ClientWidth = 724 + TabOrder = 5 + object Panel1: TPanel + Left = 0 + Height = 233 + Top = 0 + Width = 356 + BevelOuter = bvNone + ClientHeight = 233 + ClientWidth = 356 + TabOrder = 0 + object Label3: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = MatOneEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 4 + Width = 6 + Caption = '1' + ParentColor = False + end + object MatOneEdit: TEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Grid1 + AnchorSideRight.Side = asrBottom + Left = 14 + Height = 23 + Top = 0 + Width = 342 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + TabOrder = 0 + Text = 'MatOneEdit' + end + object Grid1: TStringGrid + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = MatOneEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 206 + Top = 27 + Width = 356 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 4 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll] + TabOrder = 1 + OnClick = Grid1Click + OnKeyPress = Grid1KeyPress + OnMouseDown = Grid1MouseDown + end + end + object Panel2: TPanel + Left = 0 + Height = 232 + Top = 245 + Width = 356 + BevelOuter = bvNone + ClientHeight = 232 + ClientWidth = 356 + TabOrder = 1 + object Label5: TLabel + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = MatTwoEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 4 + Width = 6 + Caption = '2' + ParentColor = False + end + object MatTwoEdit: TEdit + AnchorSideLeft.Control = Label5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = Grid2 + AnchorSideRight.Side = asrBottom + Left = 14 + Height = 23 + Top = 0 + Width = 342 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + TabOrder = 0 + Text = 'MatTwoEdit' + end + object Grid2: TStringGrid + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = MatTwoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 205 + Top = 27 + Width = 356 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoEdit = False + BorderSpacing.Top = 4 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll] + TabOrder = 1 + OnClick = Grid2Click + OnKeyPress = Grid2KeyPress + OnMouseDown = Grid2MouseDown + end + end + object Panel3: TPanel + Left = 368 + Height = 233 + Top = 0 + Width = 356 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 233 + ClientWidth = 356 + TabOrder = 2 + object Label4: TLabel + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = MatThreeEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 4 + Width = 6 + Caption = '3' + ParentColor = False + end + object MatThreeEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel3 + AnchorSideRight.Control = Grid3 + AnchorSideRight.Side = asrBottom + Left = 14 + Height = 23 + Top = 0 + Width = 342 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + TabOrder = 0 + Text = 'MatThreeEdit' + end + object Grid3: TStringGrid + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = MatThreeEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel3 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 206 + Top = 27 + Width = 356 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 4 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll] + TabOrder = 1 + OnClick = Grid3Click + OnKeyPress = Grid3KeyPress + OnMouseDown = Grid3MouseDown + end + end + object Panel4: TPanel + Left = 368 + Height = 232 + Top = 245 + Width = 356 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 232 + ClientWidth = 356 + TabOrder = 3 + object Label6: TLabel + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = MatFourEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 4 + Width = 6 + Caption = '4' + ParentColor = False + end + object MatFourEdit: TEdit + AnchorSideLeft.Control = Label6 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel4 + AnchorSideRight.Control = Grid4 + AnchorSideRight.Side = asrBottom + Left = 14 + Height = 23 + Top = 0 + Width = 342 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + TabOrder = 0 + Text = 'MatFourEdit' + end + object Grid4: TStringGrid + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = MatFourEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel4 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel4 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 205 + Top = 27 + Width = 356 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 4 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll] + TabOrder = 1 + OnClick = Grid4Click + OnKeyPress = Grid4KeyPress + OnMouseDown = Grid4MouseDown + end + end + end + object Panel6: TPanel + AnchorSideLeft.Control = Splitter1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GridNoEdit + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel5 + AnchorSideBottom.Side = asrBottom + Left = 737 + Height = 508 + Top = 8 + Width = 198 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Panel6' + ClientHeight = 508 + ClientWidth = 198 + TabOrder = 6 + object Label1: TLabel + AnchorSideLeft.Control = Panel6 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ScalarsBox + AnchorSideTop.Side = asrBottom + Left = 81 + Height = 15 + Top = 133 + Width = 37 + BorderSpacing.Top = 16 + Caption = 'SCRIPT' + ParentColor = False + end + object MatricesBox: TComboBox + AnchorSideLeft.Control = Panel6 + AnchorSideTop.Control = Panel6 + AnchorSideRight.Control = Panel6 + AnchorSideRight.Side = asrBottom + Left = 1 + Height = 23 + Top = 1 + Width = 196 + Anchors = [akTop, akLeft, akRight] + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + 'MATRICES' + ) + OnClick = MatricesBoxClick + TabOrder = 0 + Text = 'MATRICES' + end + object ColVecsBox: TComboBox + AnchorSideLeft.Control = Panel6 + AnchorSideTop.Control = MatricesBox + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel6 + AnchorSideRight.Side = asrBottom + Left = 1 + Height = 23 + Top = 32 + Width = 196 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + 'COLUMN VECTORS' + ) + OnClick = ColVecsBoxClick + TabOrder = 1 + Text = 'COLUMN VECTORS' + end + object RowVecsBox: TComboBox + AnchorSideLeft.Control = Panel6 + AnchorSideTop.Control = ColVecsBox + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel6 + AnchorSideRight.Side = asrBottom + Left = 1 + Height = 23 + Top = 63 + Width = 196 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + 'ROW VECTORS' + ) + OnClick = RowVecsBoxClick + TabOrder = 2 + Text = 'ROW VECTORS' + end + object ScalarsBox: TComboBox + AnchorSideLeft.Control = Panel6 + AnchorSideTop.Control = RowVecsBox + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel6 + AnchorSideRight.Side = asrBottom + Left = 1 + Height = 23 + Top = 94 + Width = 196 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + 'SCALARS' + ) + OnClick = ScalarsBoxClick + TabOrder = 3 + Text = 'SCALARS' + end + object ScriptList: TListBox + AnchorSideLeft.Control = Panel6 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel6 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel6 + AnchorSideBottom.Side = asrBottom + Left = 1 + Height = 358 + Top = 149 + Width = 196 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 1 + ItemHeight = 0 + OnClick = ScriptListClick + TabOrder = 4 + end + end + object Splitter1: TSplitter + AnchorSideTop.Control = Owner + AnchorSideBottom.Control = Panel5 + AnchorSideBottom.Side = asrBottom + Left = 732 + Height = 516 + Top = 0 + Width = 5 + Align = alNone + Anchors = [akTop, akLeft, akBottom] + end + object MainMenu1: TMainMenu + left = 528 + top = 168 + object FilesMenu: TMenuItem + Caption = 'Files' + object keyBdmnu: TMenuItem + Caption = 'Keyboard Input' + object MatInmnu: TMenuItem + Caption = 'Matrix' + OnClick = MatInmnuClick + end + object VecInmnu: TMenuItem + Caption = 'Vector' + OnClick = VecInmnuClick + end + object ScalarInmnu: TMenuItem + Caption = 'Scalar' + OnClick = ScalarInmnuClick + end + end + object MainGridMnu: TMenuItem + Caption = 'Read Data from Main Form Grid' + OnClick = MainGridMnuClick + end + object MenuItem3: TMenuItem + Caption = '-' + end + object OpenFileMnu: TMenuItem + Caption = 'Open File' + OnClick = OpenFileMnuClick + end + object SaveFileMnu: TMenuItem + Caption = 'Save File' + OnClick = SaveFileMnuClick + end + object PrintFileMnu: TMenuItem + Caption = 'Print File' + OnClick = PrintFileMnuClick + end + object MenuItem1: TMenuItem + Caption = '-' + end + object ImportFileMnu: TMenuItem + Caption = 'Import a file' + object TabFileInmnu: TMenuItem + Caption = 'Tab File' + end + object SpaceFileInMnu: TMenuItem + Caption = 'Space File' + end + object CommaFileInMnu: TMenuItem + Caption = 'Comma File' + end + end + object ExportFileMnu: TMenuItem + Caption = 'Export a file' + object TabFileOutMnu: TMenuItem + Caption = 'Tab File' + end + object SpaceFileOutMnu: TMenuItem + Caption = 'Space File' + end + object CommaFileOutMnu: TMenuItem + Caption = 'Comma File' + end + end + object ScriptFileInMnu: TMenuItem + Caption = 'Open a Script File' + OnClick = ScriptFileInMnuClick + end + object ScriptSaveMnu: TMenuItem + Caption = 'Save a Script File' + OnClick = ScriptSaveMnuClick + end + object ResetMnu: TMenuItem + Caption = 'Reset All' + OnClick = ResetMnuClick + end + object MenuItem2: TMenuItem + Caption = '-' + end + object ExitMnu: TMenuItem + Caption = 'Exit' + OnClick = ExitMnuClick + end + end + object MatOpsMnu: TMenuItem + Caption = 'Matrix Operations' + object IdentMnu: TMenuItem + Caption = 'Create an Indentity Matrix' + OnClick = IdentMnuClick + end + object RowAugMnu: TMenuItem + Caption = 'Row Augment' + OnClick = RowAugMnuClick + end + object ColAugMnu: TMenuItem + Caption = 'Column Augment' + OnClick = ColAugMnuClick + end + object RowDelMnu: TMenuItem + Caption = 'Delete a Row' + OnClick = RowDelMnuClick + end + object RowInstMnu: TMenuItem + Caption = 'Insert a Row' + OnClick = RowInstMnuClick + end + object ColDelMnu: TMenuItem + Caption = 'Delete a Column' + OnClick = ColDelMnuClick + end + object ColInstMnu: TMenuItem + Caption = 'Insert a Column' + OnClick = ColInstMnuClick + end + object ExtractColVecMnu: TMenuItem + Caption = 'Extract a Column Vector' + OnClick = ExtractColVecMnuClick + end + object SVDInvMnu: TMenuItem + Caption = 'SVD Inverse' + OnClick = SVDInvMnuClick + end + object TriDiagMnu: TMenuItem + Caption = 'Tridiagonalize' + OnClick = TriDiagMnuClick + end + object ULDecompMnu: TMenuItem + Caption = 'Upper-lower Decomposition' + OnClick = ULDecompMnuClick + end + object Diagtovecmnu: TMenuItem + Caption = 'Diagonal to Vector' + OnClick = DiagtovecmnuClick + end + object Vec2DiagMnu: TMenuItem + Caption = 'Vector to Diagonal' + OnClick = Vec2DiagMnuClick + end + object DetermMnu: TMenuItem + Caption = 'Determinant' + OnClick = DetermMnuClick + end + object NormRowsMnu: TMenuItem + Caption = 'Normalize Rows' + OnClick = NormRowsMnuClick + end + object NormColsMnu: TMenuItem + Caption = 'Normalize Columns' + OnClick = NormColsMnuClick + end + object PreMultMnu: TMenuItem + Caption = 'Premultiply by' + object PrebyRowVmnu: TMenuItem + Caption = 'Row Vector' + OnClick = PrebyRowVmnuClick + end + object PreMatMnu: TMenuItem + Caption = 'Matrix' + OnClick = PreMatMnuClick + end + object PreScalarMnu: TMenuItem + Caption = 'Scalar' + OnClick = PreScalarMnuClick + end + end + object PostMultMnu: TMenuItem + Caption = 'Post Multiply by' + object PostColVMnu: TMenuItem + Caption = 'Column Vector' + OnClick = PostColVMnuClick + end + object PostMatMnu: TMenuItem + Caption = 'Matrix' + OnClick = PostMatMnuClick + end + object PostScalarMnu: TMenuItem + Caption = 'Scalar' + end + end + object EigenMnu: TMenuItem + Caption = 'Eigenvalues and Vectors' + OnClick = EigenMnuClick + end + object TransMnu: TMenuItem + Caption = 'Transpose' + OnClick = TransMnuClick + end + object TraceMnu: TMenuItem + Caption = 'Trace' + OnClick = TraceMnuClick + end + object MatSumMnu: TMenuItem + Caption = 'Matrix A + Matrix B' + OnClick = MatSumMnuClick + end + object MatSubMnu: TMenuItem + Caption = 'Matrix A - Matrix B' + OnClick = MatSubMnuClick + end + object MatPrintMnu: TMenuItem + Caption = 'Print' + OnClick = MatPrintMnuClick + end + end + object VecOpsMnu: TMenuItem + Caption = 'Vector Operations' + object VecTransMnu: TMenuItem + Caption = 'Transpose' + OnClick = VecTransMnuClick + end + object VecXscalarMnu: TMenuItem + Caption = 'Times a Scalar' + OnClick = VecXscalarMnuClick + end + object VecSqrtMnu: TMenuItem + Caption = 'Square Root of Elements' + OnClick = VecSqrtMnuClick + end + object VecRecipMnu: TMenuItem + Caption = 'Reciprocal of Elements' + OnClick = VecRecipMnuClick + end + object VecPrintMnu: TMenuItem + Caption = 'Print' + OnClick = VecPrintMnuClick + end + object RowxColVecMnu: TMenuItem + Caption = 'Row Vec. x Col. Vec.' + OnClick = RowxColVecMnuClick + end + object ColxRowVecMnu: TMenuItem + Caption = 'Col. Vec. x Row Vec.' + OnClick = ColxRowVecMnuClick + end + end + object ScalarOpsMnu: TMenuItem + Caption = 'Scalar Operations' + object ScalSqrtMnu: TMenuItem + Caption = 'Square Root' + OnClick = ScalSqrtMnuClick + end + object ScalRecipMnu: TMenuItem + Caption = 'Reciprocal' + OnClick = ScalRecipMnuClick + end + object ScalxScalMnu: TMenuItem + Caption = 'Scalar x Scalar' + OnClick = ScalxScalMnuClick + end + object PrintScalMnu: TMenuItem + Caption = 'Print' + OnClick = PrintScalMnuClick + end + end + object ScriptOptMnu: TMenuItem + Caption = 'Script Operations' + object ScriptPrintMnu: TMenuItem + Caption = 'Print' + OnClick = ScriptPrintMnuClick + end + object ScriptClearMnu: TMenuItem + Caption = 'Clear' + OnClick = ScriptClearMnuClick + end + object ScriptEditMnu: TMenuItem + Caption = 'Edit' + OnClick = ScriptEditMnuClick + end + object ScriptLoadMnu: TMenuItem + Caption = 'Load' + OnClick = ScriptLoadMnuClick + end + object ScrSavMnu: TMenuItem + Caption = 'Save' + OnClick = ScrSavMnuClick + end + object ScrExeMnu: TMenuItem + Caption = 'Execute' + OnClick = ScrExeMnuClick + end + object ScriptOpsMnu: TMenuItem + Caption = 'Options' + OnClick = ScriptOpsMnuClick + end + end + object HelpMnu: TMenuItem + Caption = 'Help' + object AboutMnu: TMenuItem + Caption = 'About' + OnClick = AboutMnuClick + end + end + end + object SaveDialog1: TSaveDialog + left = 256 + top = 240 + end + object OpenDialog1: TOpenDialog + left = 256 + top = 176 + end +end diff --git a/applications/lazstats/source/forms/analysis/matrix_manipulation/matmanunit.pas b/applications/lazstats/source/forms/analysis/matrix_manipulation/matmanunit.pas new file mode 100644 index 000000000..ce7b060d6 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/matrix_manipulation/matmanunit.pas @@ -0,0 +1,8133 @@ +unit MatManUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + Menus, StdCtrls, Grids, ExtCtrls, + ScriptEditorUnit, RootMethodUnit, ScriptOptsUnit, ColInsertUnit, + RowInsertUnit, OutputUnit, Globals; + +type + DynMat = array of array of double; + DynVec = array of double; + DynIntVec = array of integer; + Dynstrarray = array of string; + Scaler = double; + ObjectNames = array of string; + +type + + { TMatManFrm } + + TMatManFrm = class(TForm) + ColVecsBox: TComboBox; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + keyBdmnu: TMenuItem; + MatInmnu: TMenuItem; + ImportFileMnu: TMenuItem; + CommaFileInMnu: TMenuItem; + ExportFileMnu: TMenuItem; + CommaFileOutMnu: TMenuItem; + ExitMnu: TMenuItem; + IdentMnu: TMenuItem; + ColAugMnu: TMenuItem; + ColDelMnu: TMenuItem; + ColInstMnu: TMenuItem; + ExtractColVecMnu: TMenuItem; + Diagtovecmnu: TMenuItem; + DetermMnu: TMenuItem; + EigenMnu: TMenuItem; + MatSumMnu: TMenuItem; + MatSubMnu: TMenuItem; + MatPrintMnu: TMenuItem; + ColxRowVecMnu: TMenuItem; + AboutMnu: TMenuItem; + MainGridMnu: TMenuItem; + MenuItem1: TMenuItem; + MenuItem2: TMenuItem; + MenuItem3: TMenuItem; + OpenDialog1: TOpenDialog; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + Panel4: TPanel; + Panel5: TPanel; + Panel6: TPanel; + SaveDialog1: TSaveDialog; + ScriptOpsMnu: TMenuItem; + ScrExeMnu: TMenuItem; + ScrSavMnu: TMenuItem; + ScriptLoadMnu: TMenuItem; + ScriptEditMnu: TMenuItem; + ScriptClearMnu: TMenuItem; + ScriptPrintMnu: TMenuItem; + PrintScalMnu: TMenuItem; + ScalxScalMnu: TMenuItem; + ScalRecipMnu: TMenuItem; + ScalSqrtMnu: TMenuItem; + RowxColVecMnu: TMenuItem; + Splitter1: TSplitter; + VecPrintMnu: TMenuItem; + VecRecipMnu: TMenuItem; + VecSqrtMnu: TMenuItem; + VecXscalarMnu: TMenuItem; + VecTransMnu: TMenuItem; + TraceMnu: TMenuItem; + TransMnu: TMenuItem; + PostScalarMnu: TMenuItem; + PostMatMnu: TMenuItem; + PostColVMnu: TMenuItem; + PostMultMnu: TMenuItem; + PreScalarMnu: TMenuItem; + PreMatMnu: TMenuItem; + PrebyRowVmnu: TMenuItem; + PreMultMnu: TMenuItem; + NormColsMnu: TMenuItem; + NormRowsMnu: TMenuItem; + Vec2DiagMnu: TMenuItem; + ULDecompMnu: TMenuItem; + TriDiagMnu: TMenuItem; + SVDInvMnu: TMenuItem; + RowInstMnu: TMenuItem; + RowDelMnu: TMenuItem; + RowAugMnu: TMenuItem; + ResetMnu: TMenuItem; + ScriptSaveMnu: TMenuItem; + ScriptFileInMnu: TMenuItem; + SpaceFileOutMnu: TMenuItem; + TabFileOutMnu: TMenuItem; + SpaceFileInMnu: TMenuItem; + TabFileInmnu: TMenuItem; + PrintFileMnu: TMenuItem; + SaveFileMnu: TMenuItem; + OpenFileMnu: TMenuItem; + ScalarInmnu: TMenuItem; + VecInmnu: TMenuItem; + Op1Edit: TEdit; + Op2Edit: TEdit; + Op3Edit: TEdit; + Op4Edit: TEdit; + MatFourEdit: TEdit; + MatThreeEdit: TEdit; + MatTwoEdit: TEdit; + MatOneEdit: TEdit; + GridNoEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + ScriptList: TListBox; + ScalarsBox: TComboBox; + RowVecsBox: TComboBox; + MatricesBox: TComboBox; + MainMenu1: TMainMenu; + FilesMenu: TMenuItem; + MatOpsMnu: TMenuItem; + HelpMnu: TMenuItem; + ScriptOptMnu: TMenuItem; + ScalarOpsMnu: TMenuItem; + Grid1: TStringGrid; + Grid2: TStringGrid; + Grid3: TStringGrid; + Grid4: TStringGrid; + VecOpsMnu: TMenuItem; + procedure AboutMnuClick(Sender: TObject); + procedure ColAugMnuClick(Sender: TObject); + procedure ColDelMnuClick(Sender: TObject); + procedure ColInstMnuClick(Sender: TObject); + procedure ColVecsBoxClick(Sender: TObject); + procedure ColxRowVecMnuClick(Sender: TObject); + procedure DetermMnuClick(Sender: TObject); + procedure DiagtovecmnuClick(Sender: TObject); + procedure EigenMnuClick(Sender: TObject); + procedure ExitMnuClick(Sender: TObject); + procedure ExtractColVecMnuClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure Grid1Click(Sender: TObject); + procedure Grid1KeyPress(Sender: TObject; var Key: char); + procedure Grid1MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure Grid2Click(Sender: TObject); + procedure Grid2KeyPress(Sender: TObject; var Key: char); + procedure Grid2MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure Grid3Click(Sender: TObject); + procedure Grid3KeyPress(Sender: TObject; var Key: char); + procedure Grid3MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure Grid4Click(Sender: TObject); + procedure Grid4KeyPress(Sender: TObject; var Key: char); + procedure Grid4MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure IdentMnuClick(Sender: TObject); + procedure MainGridMnuClick(Sender: TObject); + procedure MatInmnuClick(Sender: TObject); + procedure MatPrintMnuClick(Sender: TObject); + procedure MatricesBoxClick(Sender: TObject); + procedure MatSubMnuClick(Sender: TObject); + procedure MatSumMnuClick(Sender: TObject); + procedure NormColsMnuClick(Sender: TObject); + procedure NormRowsMnuClick(Sender: TObject); + procedure OpenFileMnuClick(Sender: TObject); + procedure PostColVMnuClick(Sender: TObject); + procedure PostMatMnuClick(Sender: TObject); + procedure PrebyRowVmnuClick(Sender: TObject); + procedure PreMatMnuClick(Sender: TObject); + procedure PreScalarMnuClick(Sender: TObject); + procedure PrintFileMnuClick(Sender: TObject); + procedure PrintScalMnuClick(Sender: TObject); + procedure ResetMnuClick(Sender: TObject); + procedure RowAugMnuClick(Sender: TObject); + procedure RowDelMnuClick(Sender: TObject); + procedure RowInstMnuClick(Sender: TObject); + procedure RowVecsBoxClick(Sender: TObject); + procedure RowxColVecMnuClick(Sender: TObject); + procedure SaveFileMnuClick(Sender: TObject); + procedure ScalarInmnuClick(Sender: TObject); + procedure ScalarsBoxClick(Sender: TObject); + procedure ScalRecipMnuClick(Sender: TObject); + procedure ScalSqrtMnuClick(Sender: TObject); + procedure ScalxScalMnuClick(Sender: TObject); + procedure ScrExeMnuClick(Sender: TObject); + procedure ScriptClearMnuClick(Sender: TObject); + procedure ScriptEditMnuClick(Sender: TObject); + procedure ScriptFileInMnuClick(Sender: TObject); + procedure ScriptListClick(Sender: TObject); + procedure ScriptLoadMnuClick(Sender: TObject); + procedure ScriptOpsMnuClick(Sender: TObject); + procedure ScriptPrintMnuClick(Sender: TObject); + procedure ScriptSaveMnuClick(Sender: TObject); + procedure ScrSavMnuClick(Sender: TObject); + procedure SVDInvMnuClick(Sender: TObject); + procedure TraceMnuClick(Sender: TObject); + procedure TransMnuClick(Sender: TObject); + procedure TriDiagMnuClick(Sender: TObject); + procedure ULDecompMnuClick(Sender: TObject); + procedure Vec2DiagMnuClick(Sender: TObject); + procedure VecInmnuClick(Sender: TObject); + procedure VecPrintMnuClick(Sender: TObject); + procedure VecRecipMnuClick(Sender: TObject); + procedure VecSqrtMnuClick(Sender: TObject); + procedure VecTransMnuClick(Sender: TObject); + procedure VecXscalarMnuClick(Sender: TObject); + private + { private declarations } + procedure GetFile(Sender: TObject); + procedure GetGridData(gridno : integer); + FUNCTION sign(a,b: double): double; + FUNCTION max(a,b: double): double; + PROCEDURE matinv(a, vtimesw, v, w: DynMat; n: integer); + procedure ResetGrids(Sender : TObject); + function DuplicateMat(str : string): boolean; + function DuplicateColVec(str : string): boolean; + function DuplicateRowVec(str : string): boolean; + function DuplicateScaler(str : string): boolean; + procedure tred2(VAR a: DynMat; n: integer; VAR d,e: DynVec); + procedure ludcmp(VAR a: DynMat; n: integer; VAR indx: DynIntVec; VAR d: double); + procedure DynMatPrint(VAR xmat : DynMat ; rows, cols : integer; + VAR title : string; VAR ColHeadings : Dynstrarray); + procedure ComboAdd(FileName : String); + procedure tqli(VAR d : DynVec; VAR e : DynVec; n : integer; VAR z : DynMat); + procedure xtqli(VAR a : DynMat; NP : integer; VAR d : DynVec; VAR f : DynVec; VAR e : DynVec); + function SEVS(nv, nf : integer; C : double; VAR r : DynMat; VAR v : DynMat; VAR e : DynVec; VAR p : DynVec; nd : integer) : integer; + procedure nonsymroots(VAR a : DynMat; nv : integer; VAR nf : integer; c : double; VAR v : DynMat; VAR e : DynVec; VAR x : DynVec; VAR t : double; VAR ev : double); + procedure OPRINC(S : DynVec; M, IA : integer; VAR EVAL : DynVec; VAR EVEC : DynMat; VAR COMP : DynMat; VAR VARPCNT : DynVec; VAR CL : DynVec; VAR CU : DynVec; VAR IER : integer); + procedure EHOUSS(VAR A : DynVec; N : integer; VAR D : DynVec; VAR E : DynVec; VAR E2 : DynVec); + function DSIGN(X, Y : double) : double; + FUNCTION isign(a,b : integer): integer; + procedure EQRT2S(VAR D : DynVec; VAR E : DynVec; N : integer; VAR Z : DynMat; VAR IZ : integer; VAR IER : integer); + procedure EHOBKS(VAR A : DynVec; N, M1, M2 : integer; VAR Z : DynMat; IZ : integer); + procedure UERTST(IER : integer; aNAME : string); + procedure Roots(VAR RMat : DynMat; NITEMS : integer; VAR EIGENVAL : DynVec; + VAR EIGENVEC : DynMat); + procedure SymMatRoots(A : DynMat; M : integer; VAR E : DynVec; VAR V : DynMat); + function OpParse(VAR Operation : string; OpStr : string; + VAR Op1 : string; VAR Op2 : string; VAR Op3 : string; + VAR Opergrid : integer; VAR Op1grid : integer; + VAR Op2grid : integer; VAR Op3grid : integer) : integer; + procedure OperExec; + + private + Opstr, Operation, Op1, Op2, Op3 : string; + Opergrid, Op1grid, Op2grid, Op3grid : integer; + ScriptName : string; + + public + { public declarations } + CurrentObjType : integer; + CurrentObjName : string; + MatCount : integer; + ColVecCount : integer; + RowVecCount : integer; + ScaCount : integer; + Matrix1 : DynMat; + Matrix2 : DynMat; + Matrix3 : DynMat; + Matrix4 : DynMat; + ScriptOp : boolean; + LastScript : integer; + LastGridNo : integer; + CurrentGrid : integer; + Rows1, Rows2, Rows3, Rows4 : integer; + Cols1, Cols2, Cols3, Cols4 : integer; + Rows, Cols : integer; + Saved : boolean; + + end; + +var + MatManFrm: TMatManFrm; + +implementation + +uses + MainUnit; + +{ TMatManFrm } + + +procedure TMatManFrm.FormCreate(Sender: TObject); +begin + if ScriptEditorFrm <> nil then + Application.CreateForm(TScriptEditorFrm, ScriptEditorFrm); + if ScriptOptsFrm <> nil then + Application.CreateForm(TScriptOptsFrm, ScriptOptsFrm); + if OutputFrm <> nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TMatManFrm.FormShow(Sender: TObject); +var + count, index : integer; + filename, matext, cvecext, rvecext, scaext, extstr : string; + scriptopts : TextFile; + checked : integer; +begin + ResetGrids(Self); + matext := '.MAT'; + cvecext := '.CVE'; + rvecext := '.RVE'; + scaext := '.SCA'; + scripteditorfrm.FileListBox1.Directory := Options.DefaultPath; + scripteditorfrm.FileListBox1.Update; + count := scripteditorfrm.FileListBox1.Items.Count; + for index := 0 to count-1 do + begin + filename := scripteditorfrm.FileListBox1.Items.Strings[index]; + filename := ExtractFileName(filename); + extstr := copy(filename,Length(filename)-3,4); + if extstr = matext then MatricesBox.Items.Add(filename); + if extstr = cvecext then ColVecsBox.Items.Add(filename); + if extstr = rvecext then RowVecsBox.Items.Add(filename); + if extstr = scaext then ScalarsBox.Items.Add(filename); + end; + if FileExists('Options.SCR') then + begin + AssignFile(scriptopts, 'Options.SCR'); + Reset(scriptopts); + Readln(scriptopts,checked); + if checked = 1 then scriptoptsfrm.CheckGroup1.Checked[0] := true; + Readln(scriptopts,checked); + if checked = 1 then scriptoptsfrm.CheckGroup1.Checked[1] := true; + CloseFile(scriptopts); + end; +end; + +procedure TMatManFrm.Grid1Click(Sender: TObject); +begin + CurrentGrid := 1; + CurrentObjName := MatOneEdit.Text; + GridNoEdit.Text := IntToStr(1); + if ((Rows1 > 2) and (Cols1 > 2)) then CurrentObjType := 1; + if ((Rows1 > 2) and (Cols1 = 2)) then CurrentObjType := 2; + if ((Rows1 = 2) and (Cols1 > 2)) then CurrentObjType := 3; + if ((Rows1 = 2) and (Cols1 = 2)) then CurrentObjType := 4; +end; + +procedure TMatManFrm.Grid1KeyPress(Sender: TObject; var Key: char); +var + instr : string; + +begin + if Ord(Key) = 13 then // return pressed + begin + if ((Grid1.Row = Rows) and (Grid1.Col = Cols)) then + begin + instr := InputBox('SAVE','Save object?','Yes'); + if instr = 'Yes' then SaveFileMnuClick(Self); + end; + end; +end; + +procedure TMatManFrm.Grid1MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var i, j : integer; + +begin + if Button = mbRight then // reset the grid + begin + for i := 1 to rows1 do + for j := 1 to cols1 do + Grid1.Cells[j,i] := ''; + Grid1.RowCount := 5; + Grid1.ColCount := 5; + for i := 1 to 4 do Grid1.Cells[i,0] := 'Col.' + IntToStr(i); + for i := 1 to 4 do Grid1.Cells[0,i] := 'Row' + IntToStr(i); + rows1 := 4; + cols1 := 4; + Grid1.RowCount := 5; + Grid1.ColCount := 5; + MatOneEdit.Text := ''; + end; +end; + +procedure TMatManFrm.Grid2Click(Sender: TObject); +begin + CurrentGrid := 2; + CurrentObjName := MatTwoEdit.Text; + GridNoEdit.Text := IntToStr(2); + if ((Rows2 > 2) and (Cols2 > 2)) then CurrentObjType := 1; + if ((Rows2 > 2) and (Cols2 = 2)) then CurrentObjType := 2; + if ((Rows2 = 2) and (Cols2 > 2)) then CurrentObjType := 3; + if ((Rows2 = 2) and (Cols2 = 2)) then CurrentObjType := 4; +end; + +procedure TMatManFrm.Grid2KeyPress(Sender: TObject; var Key: char); +var + instr : string; + +begin + CurrentGrid := 2; + if Ord(Key) = 13 then // return pressed + begin + if ((Grid2.Row = Rows) and (Grid2.Col = Cols)) then + begin + instr := InputBox('SAVE','Save object?','Yes'); + if instr = 'Yes' then SaveFileMnuClick(Self); + end; + end; +end; + +procedure TMatManFrm.Grid2MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var i, j : integer; + +begin + if Button = mbRight then // reset the grid + begin + for i := 1 to rows2 do + for j := 1 to cols2 do + Grid2.Cells[j,i] := ''; + Grid2.RowCount := 5; + Grid2.ColCount := 5; + for i := 1 to 4 do Grid2.Cells[i,0] := 'Col.' + IntToStr(i); + for i := 1 to 4 do Grid2.Cells[0,i] := 'Row' + IntToStr(i); + rows2 := 4; + cols2 := 4; + Grid2.RowCount := 5; + Grid2.ColCount := 5; + MatTwoEdit.Text := ''; + end; +end; + +procedure TMatManFrm.Grid3Click(Sender: TObject); +begin + CurrentGrid := 3; + CurrentObjName := MatThreeEdit.Text; + GridNoEdit.Text := IntToStr(3); + if ((Rows3 > 2) and (Cols3 > 2)) then CurrentObjType := 1; + if ((Rows3 > 2) and (Cols3 = 2)) then CurrentObjType := 2; + if ((Rows3 = 2) and (Cols3 > 2)) then CurrentObjType := 3; + if ((Rows3 = 2) and (Cols3 = 2)) then CurrentObjType := 4; +end; + +procedure TMatManFrm.Grid3KeyPress(Sender: TObject; var Key: char); +var + instr : string; + +begin + CurrentGrid := 3; + if Ord(Key) = 13 then // return pressed + begin + if ((Grid3.Row = Rows) and (Grid3.Col = Cols)) then + begin + instr := InputBox('SAVE','Save object?','Yes'); + if instr = 'Yes' then SaveFileMnuClick(Self); + end; + end; +end; + +procedure TMatManFrm.Grid3MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var i, j : integer; + +begin + if Button = mbRight then // reset the grid + begin + for i := 1 to rows3 do + for j := 1 to cols3 do + Grid3.Cells[j,i] := ''; + Grid3.RowCount := 5; + Grid3.ColCount := 5; + for i := 1 to 4 do Grid3.Cells[i,0] := 'Col.' + IntToStr(i); + for i := 1 to 4 do Grid3.Cells[0,i] := 'Row' + IntToStr(i); + rows3 := 4; + cols3 := 4; + Grid3.RowCount := 5; + Grid3.ColCount := 5; + MatThreeEdit.Text := ''; + end; +end; + +procedure TMatManFrm.Grid4Click(Sender: TObject); +begin + CurrentGrid := 4; + CurrentObjName := MatFourEdit.Text; + GridNoEdit.Text := IntToStr(4); + if ((Rows4 > 2) and (Cols4 > 2)) then CurrentObjType := 1; + if ((Rows4 > 2) and (Cols4 = 2)) then CurrentObjType := 2; + if ((Rows4 = 2) and (Cols4 > 2)) then CurrentObjType := 3; + if ((Rows4 = 2) and (Cols4 = 2)) then CurrentObjType := 4; +end; + +procedure TMatManFrm.Grid4KeyPress(Sender: TObject; var Key: char); +var + instr : string; + +begin + CurrentGrid := 4; + if Ord(Key) = 13 then // return pressed + begin + if ((Grid4.Row = Rows) and (Grid4.Col = Cols)) then + begin + instr := InputBox('SAVE','Save object?','Yes'); + if instr = 'Yes' then SaveFileMnuClick(Self); + end; + end; +end; + +procedure TMatManFrm.Grid4MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var i, j : integer; + +begin + if Button = mbRight then // reset the grid + begin + for i := 1 to rows4 do + for j := 1 to cols4 do + Grid4.Cells[j,i] := ''; + Grid4.RowCount := 5; + Grid4.ColCount := 5; + for i := 1 to 4 do Grid4.Cells[i,0] := 'Col.' + IntToStr(i); + for i := 1 to 4 do Grid4.Cells[0,i] := 'Row' + IntToStr(i); + rows4 := 4; + cols4 := 4; + Grid4.RowCount := 5; + Grid4.ColCount := 5; + MatFourEdit.Text := ''; + end; +end; + +procedure TMatManFrm.IdentMnuClick(Sender: TObject); +var + info, prmptstr, newstring : string; + i, j, nsize, gridno : integer; + wasclicked : boolean; +begin + prmptstr := 'Enter the number of rows and columns:'; + info := InputBox('MATRIX SIZE',prmptstr,'4'); + nsize := StrToInt(info); + if nsize <= 0 then exit; + prmptstr := 'Place the matrix in grid:'; + info := InputBox('GRID NO.',prmptstr,IntToStr(CurrentGrid)); + gridno := StrToInt(info); + case gridno of + 1 : begin + Grid1.RowCount := nsize + 1; + Grid1.ColCount := nsize + 1; + for i := 1 to nsize do + begin + for j := 1 to nsize do + begin + if i <> j then Grid1.Cells[i,j] := FloatToStr(0.0) + else Grid1.Cells[i,j] := FloatToStr(1.0); + Grid1.Cells[j,0] := 'Col.' + IntToStr(j); + end; + Grid1.Cells[0,i] := 'Row ' + IntToStr(i); + end; + Rows1 := nsize; + Cols1 := nsize; + end; + 2 : begin + Grid2.RowCount := nsize + 1; + Grid2.ColCount := nsize + 1; + for i := 1 to nsize do + begin + for j := 1 to nsize do + begin + if i <> j then Grid2.Cells[i,j] := FloatToStr(0.0) + else Grid2.Cells[i,j] := FloatToStr(1.0); + Grid2.Cells[j,0] := 'Col.' + IntToStr(j); + end; + Grid2.Cells[0,i] := 'Row ' + IntToStr(i); + end; + Rows2 := nsize; + Cols2 := nsize; + end; + 3 : begin + Grid3.RowCount := nsize + 1; + Grid3.ColCount := nsize + 1; + for i := 1 to nsize do + begin + for j := 1 to nsize do + begin + if i <> j then Grid3.Cells[i,j] := FloatToStr(0.0) + else Grid3.Cells[i,j] := FloatToStr(1.0); + Grid3.Cells[j,0] := 'Col.' + IntToStr(j); + end; + Grid3.Cells[0,i] := 'Row ' + IntToStr(i); + end; + Rows3 := nsize; + Cols3 := nsize; + end; + 4 : begin + Grid4.RowCount := nsize + 1; + Grid4.ColCount := nsize + 1; + for i := 1 to nsize do + begin + for j := 1 to nsize do + begin + if i <> j then Grid4.Cells[i,j] := FloatToStr(0.0) + else Grid4.Cells[i,j] := FloatToStr(1.0); + Grid4.Cells[j,0] := 'Col.' + IntToStr(j); + end; + Grid4.Cells[0,i] := 'Row ' + IntToStr(i); + end; + Rows4 := nsize; + Cols4 := nsize; + end; + end; + CurrentGrid := gridno; + CurrentObjType := 1; + CurrentObjName := 'IDMAT'; + Op1Edit.Text := Operation; + Op2Edit.Text := 'IDMAT'; + if scriptop = false then + begin + prmptstr := 'Save identity matrix as '; + newstring := 'IDMAT'; + wasclicked := InputQuery('MATRIX NAME',prmptstr,newstring); + if wasclicked then info := newstring else info := 'IDMAT'; + CurrentObjName := info; + Op2Edit.Text := info; + opstr := IntToStr(gridno) + '-IDMAT:'; + opstr := opstr + IntToStr(gridno) + '-' + Op2Edit.Text; + ScriptList.Items.Add(opstr); + if wasclicked then SaveFileMnuClick(Self); + ComboAdd(CurrentObjName); + end; + case gridno of + 1 : MatOneEdit.Text := Op2Edit.Text; + 2 : MatTwoEdit.Text := Op2Edit.Text; + 3 : MatThreeEdit.Text := Op2Edit.Text; + 4 : MatFourEdit.Text := Op2Edit.Text; + end; +end; + +procedure TMatManFrm.MainGridMnuClick(Sender: TObject); +VAR + mrows,mcols,i,j : integer; + titlestr, instr : string; + FName : string; +begin + mrows := OS3MainFrm.DataGrid.RowCount; + mcols := OS3MainFrm.DataGrid.ColCount; + titlestr := OS3MainFrm.FileNameEdit.Text; + instr := InputBox('GRID?','Which grid no. (1-4):','1'); + CurrentGrid := StrToInt(instr); + if ((CurrentGrid < 1) or (CurrentGrid > 4)) then CurrentGrid := 1; + GridNoEdit.Text := IntToStr(CurrentGrid); + CurrentObjName := 'MainGridData.MAT'; //titlestr; + Rows := mrows-1; + Cols := mcols-1; + case CurrentGrid of + 1 : begin + Rows1 := Rows; + Cols1 := Cols; + MatOneEdit.Text := CurrentObjName; + Grid1.RowCount := Rows1+1; + Grid1.ColCount := Cols1+1; + for i := 0 to Rows1 do + for j := 0 to Cols1 do + Grid1.Cells[j,i] := ''; + for i := 1 to Cols1 do Grid1.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Row' + IntToStr(i); + for i := 1 to Rows1 do + for j := 1 to Cols1 do + Grid1.Cells[j,i] := OS3MainFrm.DataGrid.Cells[j,i]; + end; + 2 : begin + Rows2 := Rows; + Cols2 := Cols; + MatTwoEdit.Text := CurrentObjName; + Grid2.RowCount := Rows2+1; + Grid2.ColCount := Cols2+1; + for i := 0 to Rows2 do + for j := 0 to Cols2 do + Grid2.Cells[j,i] := ''; + for i := 1 to Cols2 do Grid2.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Row' + IntToStr(i); + for i := 1 to Rows2 do + for j := 1 to Cols2 do + Grid2.Cells[j,i] := OS3MainFrm.DataGrid.Cells[j,i]; + end; + 3 : begin + Rows3 := Rows; + Cols3 := Cols; + MatThreeEdit.Text := CurrentObjName; + Grid3.RowCount := Rows3+1; + Grid3.ColCount := Cols3+1; + for i := 0 to Rows3 do + for j := 0 to Cols3 do + Grid3.Cells[j,i] := ''; + for i := 1 to Cols3 do Grid3.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Row' + IntToStr(i); + for i := 1 to Rows3 do + for j := 1 to Cols3 do + Grid3.Cells[j,i] := OS3MainFrm.DataGrid.Cells[j,i]; + end; + 4 : begin + Rows4 := Rows; + Cols4 := Cols; + MatFourEdit.Text := CurrentObjName; + Grid4.RowCount := Rows4+1; + Grid4.ColCount := Cols4+1; + for i := 0 to Rows4 do + for j := 0 to Cols4 do + Grid4.Cells[j,i] := ''; + for i := 1 to Cols4 do Grid4.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Row' + IntToStr(i); + for i := 1 to Rows4 do + for j := 1 to Cols4 do + Grid4.Cells[j,i] := OS3MainFrm.DataGrid.Cells[j,i]; + end; + end; // case + CurrentObjType := 1; + MatCount := MatCount + 1; + Op1Edit.Text := 'KeyMatInput'; + Op2Edit.Text := CurrentObjName; + Op3Edit.Text := ''; + FName := ExtractFileName(CurrentObjName); + SaveFileMnuClick(self); + ComboAdd(FName); + case CurrentGrid of + 1 : Grid1.SetFocus; + 2 : Grid2.SetFocus; + 3 : Grid3.SetFocus; + 4 : Grid4.SetFocus; + end; +end; + +procedure TMatManFrm.MatInmnuClick(Sender: TObject); +var + instr : string; + i, j : integer; + +begin + instr := InputBox('GRID?','Which grid no. (1-4):','1'); + CurrentGrid := StrToInt(instr); + if ((CurrentGrid < 1) or (CurrentGrid > 4)) then CurrentGrid := 1; + GridNoEdit.Text := IntToStr(CurrentGrid); + instr := InputBox('NAME','Object name:','AMatrix'); + CurrentObjName := instr; + instr := InputBox('ROWS','No. of Rows = ','3'); + Rows := StrToInt(instr); + instr := InputBox('COLS','No. of Columns = ','3'); + Cols := StrToInt(instr); + case CurrentGrid of + 1 : begin + Rows1 := Rows; + Cols1 := Cols; + MatOneEdit.Text := CurrentObjName; + Grid1.RowCount := Rows1 + 1; + Grid1.ColCount := Cols1 + 1; + for i := 0 to Rows1 do + for j := 0 to Cols1 do + Grid1.Cells[j,i] := ''; + for i := 1 to Cols1 do Grid1.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Row' + IntToStr(i); + end; + 2 : begin + Rows2 := Rows; + Cols2 := Cols; + MatTwoEdit.Text := CurrentObjName; + Grid2.RowCount := Rows2 + 1; + Grid2.ColCount := Cols2 + 1; + for i := 0 to Rows2 do + for j := 0 to Cols2 do + Grid2.Cells[j,i] := ''; + for i := 1 to Cols2 do Grid2.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Row' + IntToStr(i); + end; + 3 : begin + Rows3 := Rows; + Cols3 := Cols; + MatThreeEdit.Text := CurrentObjName; + Grid3.RowCount := Rows3 + 1; + Grid3.ColCount := Cols3 + 1; + for i := 0 to Rows3 do + for j := 0 to Cols3 do + Grid3.Cells[j,i] := ''; + for i := 1 to Cols3 do Grid3.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Row' + IntToStr(i); + end; + 4 : begin + Rows4 := Rows; + Cols4 := Cols; + MatFourEdit.Text := CurrentObjName; + Grid4.RowCount := Rows4 + 1; + Grid4.ColCount := Cols4 + 1; + for i := 0 to Rows4 do + for j := 0 to Cols4 do + Grid4.Cells[j,i] := ''; + for i := 1 to Cols4 do Grid4.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Row' + IntToStr(i); + end; + end; // case + CurrentObjType := 1; + MatCount := MatCount + 1; + Op1Edit.Text := 'KeyMatInput'; + Op2Edit.Text := CurrentObjName; + Op3Edit.Text := ''; + case CurrentGrid of + 1 : Grid1.SetFocus; + 2 : Grid2.SetFocus; + 3 : Grid3.SetFocus; + 4 : Grid4.SetFocus; + end; +end; + +procedure TMatManFrm.MatPrintMnuClick(Sender: TObject); +var + Matrix : DynMat; + ColHeadings : DynStrarray; + i, j : integer; + nrows, ncols : integer; + title : string; + +begin + OutputFrm.RichEdit.Clear; + case currentgrid of + 1 : begin + SetLength(Matrix,Rows1,Cols1); + SetLength(ColHeadings,Cols1); + nrows := rows1; + ncols := cols1; + for i := 0 to rows1-1 do + for j := 0 to cols1-1 do + Matrix[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + for i := 1 to Cols1 do ColHeadings[i-1] := Grid1.Cells[i,0]; + title := MatOneEdit.Text; + end; + 2 : begin + SetLength(Matrix,Rows2,Cols2); + SetLength(ColHeadings,Cols2); + nrows := rows2; + ncols := cols2; + for i := 0 to rows2-1 do + for j := 0 to cols2-1 do + Matrix[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + for i := 1 to Cols2 do ColHeadings[i-1] := Grid2.Cells[i,0]; + title := MatTwoEdit.Text; + end; + 3 : begin + SetLength(Matrix,Rows3,Cols3); + SetLength(ColHeadings,Cols3); + nrows := rows3; + ncols := cols3; + for i := 0 to rows3-1 do + for j := 0 to cols3-1 do + Matrix[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + for i := 1 to Cols3 do ColHeadings[i-1] := Grid3.Cells[i,0]; + title := MatThreeEdit.Text; + end; + 4 : begin + SetLength(Matrix,Rows4,Cols4); + SetLength(ColHeadings,Cols4); + nrows := rows4; + ncols := cols4; + for i := 0 to rows4-1 do + for j := 0 to cols4-1 do + Matrix[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + for i := 1 to Cols4 do ColHeadings[i-1] := Grid4.Cells[i,0]; + title := MatFourEdit.Text; + end; + end; + title := title + format(' From Grid Number %d',[currentgrid]); + DynMatPrint(Matrix,nrows,ncols,title,ColHeadings); + OutputFrm.ShowModal; + ColHeadings := nil; + Matrix := nil; +end; + +procedure TMatManFrm.MatricesBoxClick(Sender: TObject); +var + matstr : string; + answer : string; + indexno : integer; + gridno : integer; + +begin + indexno := MatricesBox.ItemIndex; + if indexno < 0 then exit; + matstr := MatricesBox.Items.Strings[indexno]; + answer := InputBox('PLACEMENT','Place in which Grid?','1'); + gridno := StrToInt(answer); + if ((gridno < 1) or (gridno > 4)) then + begin + ShowMessage('Error - Grid number must be between 1 and 4.'); + exit; + end; + CurrentGrid := gridno; + CurrentObjType := 1; + CurrentObjName := matstr; + OpenDialog1.FileName := matstr; + GetFile(Self); + MatricesBox.Text := 'MATRICES'; + MatricesBox.ItemIndex := -1; +end; + +procedure TMatManFrm.MatSubMnuClick(Sender: TObject); +// Subtraction of two matrices +var + i, j : integer; + precols, postcols, prerows, postrows : integer; + info : string; + pregrid, postgrid, resultgrid : integer; + prmptstr : string; + premat, postmat, prodmat : DynMat; + clickedok : boolean; + defaultstr : string; + +begin + if ScriptOp = false then + begin + prmptstr := 'The first matrix is in '; + info := inputbox('GRID A',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + pregrid := StrToInt(info); + prmptstr := 'The second matrix is in '; + info := InputBox('GRID B',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + postgrid := StrToInt(info); + info := inputbox('RESULTS INTO','Place results in grid :','3'); + if info = '' then exit; + resultgrid := StrToInt(info); + end + else begin // executing the script + pregrid := 1; + postgrid := 2; + resultgrid := 3; + end; + case pregrid of + 1 : begin + precols := Cols1; + prerows := Rows1; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op2Edit.Text := ExtractFileName(MatOneEdit.Text); + end; + 2 : begin + precols := Cols2; + prerows := Rows2; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op2Edit.Text := ExtractFileName(MatTwoEdit.Text); + end; + 3 : begin + precols := Cols3; + prerows := Rows3; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op2Edit.Text := ExtractFileName(MatThreeEdit.Text); + end; + 4 : begin + precols := Cols4; + prerows := Rows4; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op2Edit.Text := ExtractFileName(MatFourEdit.Text); + end; + end; + case postgrid of + 1 : begin + postcols := Cols1; + postrows := Rows1; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op3Edit.Text := ExtractFileName(MatOneEdit.Text); + end; + 2 : begin + postcols := Cols2; + postrows := Rows2; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op3Edit.Text := ExtractFileName(MatTwoEdit.Text); + end; + 3 : begin + postcols := Cols3; + postrows := Rows3; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op3Edit.Text := ExtractFileName(MatThreeEdit.Text); + end; + 4 : begin + postcols := Cols4; + postrows := Rows4; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op3Edit.Text := ExtractFileName(MatFourEdit.Text); + end; + end; + SetLength(prodmat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + prodmat[i,j] := premat[i,j] - postmat[i,j]; + case resultgrid of + 1 : begin + Grid1.RowCount := prerows+1; + Grid1.ColCount := precols+1; + Rows1 := prerows; + Cols1 := precols; + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + Grid1.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + MatOneEdit.Text := 'MatrixDiff'; + Op4Edit.Text := MatOneEdit.Text; + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols1 do Grid1.Cells[i,0] := 'Col.' + IntToStr(i); + end; + 2 : begin + Grid2.RowCount := prerows+1; + Grid2.ColCount := precols+1; + Rows2 := prerows; + Cols2 := precols; + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + Grid2.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + MatTwoEdit.Text := 'MatrixDiff'; + Op4Edit.Text := MatTwoEdit.Text; + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols2 do Grid2.Cells[i,0] := 'Col.' + IntToStr(i); + end; + 3 : begin + Grid3.RowCount := prerows+1; + Grid3.ColCount := precols+1; + Rows3 := prerows; + Cols3 := precols; + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + Grid3.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + MatThreeEdit.Text := 'MatrixDiff'; + Op4Edit.Text := MatThreeEdit.Text; + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols3 do Grid3.Cells[i,0] := 'Col.' + IntToStr(i); + end; + 4 : begin + Grid4.RowCount := prerows+1; + Grid4.ColCount := precols+1; + Rows4 := prerows; + Cols4 := precols; + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + Grid4.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + MatFourEdit.Text := 'MatrixDiff'; + Op4Edit.Text := MatFourEdit.Text; + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols4 do Grid4.Cells[i,0] := 'Col.' + IntToStr(i); + end; + end; + Op1Edit.Text := 'MatMinusMat'; + opstr := IntToStr(CurrentGrid) + '-' + 'MatMinusMat:'+ IntToStr(pregrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(postgrid) + '-' + Op3Edit.Text; + if ScriptOp = false then + begin + prmptstr := 'Save difference as: '; + defaultstr := 'MatMinusMat'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'MatMinusMat'; + if Length(info) > 0 then + begin + Op4Edit.Text := info; + end + else begin + Op4Edit.Text := 'MatMinusMat'; + info := 'MatMinusMat'; + end; + opstr := opstr + ':' + IntToStr(resultgrid) + '-' + Op4Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 1; + CurrentGrid := resultgrid; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case resultgrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; + // deallocate memory + prodmat := nil; + postmat := nil; + premat := nil; +end; + +procedure TMatManFrm.MatSumMnuClick(Sender: TObject); +// Addition of two matrices +var + i, j : integer; + precols, postcols, prerows, postrows : integer; + info : string; + pregrid, postgrid, resultgrid : integer; + prmptstr : string; + premat, postmat, prodmat : DynMat; + clickedok : boolean; + defaultstr : string; + +begin + if ScriptOp = false then + begin + prmptstr := 'The First Matrix in grid: '; + info := InputBox('MATRIX A',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + pregrid := StrToInt(info); + prmptstr := 'The second Matrix is in grid: '; + info := inputbox('MATRIX B',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + postgrid := StrToInt(info); + info := inputbox('RESULTS INTO','Place results in grid :','3'); + if info = '' then exit; + resultgrid := StrToInt(info); + end + else begin // executing the script + pregrid := 1; + postgrid := 2; + resultgrid := 3; + end; + case pregrid of + 1 : begin + precols := Cols1; + prerows := Rows1; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op2Edit.Text := ExtractFileName(MatOneEdit.Text); + end; + 2 : begin + precols := Cols2; + prerows := Rows2; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op2Edit.Text := ExtractFileName(MatTwoEdit.Text); + end; + 3 : begin + precols := Cols3; + prerows := Rows3; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op2Edit.Text := ExtractFileName(MatThreeEdit.Text); + end; + 4 : begin + precols := Cols4; + prerows := Rows4; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op2Edit.Text := ExtractFileName(MatFourEdit.Text); + end; + end; + case postgrid of + 1 : begin + postcols := Cols1; + postrows := Rows1; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op3Edit.Text := ExtractFileName(MatOneEdit.Text); + end; + 2 : begin + postcols := Cols2; + postrows := Rows2; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op3Edit.Text := ExtractFileName(MatTwoEdit.Text); + end; + 3 : begin + postcols := Cols3; + postrows := Rows3; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op3Edit.Text := ExtractFileName(MatThreeEdit.Text); + end; + 4 : begin + postcols := Cols4; + postrows := Rows4; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op3Edit.Text := ExtractFileName(MatFourEdit.Text); + end; + end; + SetLength(prodmat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + prodmat[i,j] := premat[i,j] + postmat[i,j]; + case resultgrid of + 1 : begin + Grid1.RowCount := prerows+1; + Grid1.ColCount := postcols+1; + Rows1 := prerows; + Cols1 := precols; + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + Grid1.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols1 do Grid1.Cells[i,0] := 'Col.' + IntToStr(i); + MatOneEdit.Text := 'MatrixSum'; + Op4Edit.Text := MatOneEdit.Text; + end; + 2 : begin + Grid2.RowCount := prerows+1; + Grid2.ColCount := postcols+1; + Rows2 := prerows; + Cols2 := precols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid2.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols2 do Grid2.Cells[i,0] := 'Col.' + IntToStr(i); + MatTwoEdit.Text := 'MatrixSum'; + Op4Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + Grid3.RowCount := prerows+1; + Grid3.ColCount := postcols+1; + Rows3 := prerows; + Cols3 := precols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid3.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols3 do Grid3.Cells[i,0] := 'Col.' + IntToStr(i); + MatThreeEdit.Text := 'MatrixSum'; + Op4Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + Grid4.RowCount := prerows+1; + Grid4.ColCount := postcols+1; + Rows4 := prerows; + Cols4 := precols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid4.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols4 do Grid4.Cells[i,0] := 'Col.' + IntToStr(i); + MatFourEdit.Text := 'MatrixSum'; + Op4Edit.Text := MatFourEdit.Text; + end; + end; + Op1Edit.Text := 'MatPlusMat'; + opstr := IntToStr(CurrentGrid) + '-'; + opstr := opstr + 'MatPlusMat:'+ IntToStr(pregrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(postgrid) + '-' + Op3Edit.Text; + if ScriptOp = false then + begin + prmptstr := 'Save sum as: '; + defaultstr := 'MatPlusMat'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'MatPlusMat'; + if Length(info) > 0 then + begin + Op4Edit.Text := info; + end + else begin + Op4Edit.Text := 'MatPlusMat'; + info := 'MatPlusMat'; + end; + opstr := opstr + ':' + IntToStr(resultgrid) + '-' + Op4Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 1; + CurrentGrid := resultgrid; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case resultgrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; + // deallocate memory + prodmat := nil; + postmat := nil; + premat := nil; +end; + +procedure TMatManFrm.NormColsMnuClick(Sender: TObject); +var + i, j : integer; + sum : double; + prmptstr, info : string; + clickedok : boolean; + defaultstr : string; +begin + case CurrentGrid of + 1 : for j := 1 to Grid1.ColCount - 1 do + begin + sum := 0.0; + for i := 1 to Grid1.RowCount - 1 do + begin + sum := sum + sqr(StrToFloat(Grid1.Cells[j,i])); + end; + sum := sqrt(sum); + for i := 1 to Grid1.RowCount - 1 do + begin + Grid1.Cells[j,i] := FloatToStr(StrToFloat(Grid1.Cells[j,i]) / sum); + end; + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : for j := 1 to Grid2.ColCount - 1 do + begin + sum := 0.0; + for i := 1 to Grid2.RowCount - 1 do + begin + sum := sum + sqr(StrToFloat(Grid2.Cells[j,i])); + end; + sum := sqrt(sum); + for i := 1 to Grid2.RowCount - 1 do + begin + Grid2.Cells[j,i] := FloatToStr(StrToFloat(Grid2.Cells[j,i]) / sum); + end; + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : for j := 1 to Grid3.ColCount - 1 do + begin + sum := 0.0; + for i := 1 to Grid3.RowCount - 1 do + begin + sum := sum + sqr(StrToFloat(Grid3.Cells[j,i])); + end; + sum := sqrt(sum); + for i := 1 to Grid3.RowCount - 1 do + begin + Grid3.Cells[j,i] := FloatToStr(StrToFloat(Grid3.Cells[j,i]) / sum); + end; + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : for j := 1 to Grid4.ColCount - 1 do + begin + sum := 0.0; + for i := 1 to Grid4.RowCount - 1 do + begin + sum := sum + sqr(StrToFloat(Grid4.Cells[j,i])); + end; + sum := sqrt(sum); + for i := 1 to Grid4.RowCount - 1 do + begin + Grid4.Cells[j,i] := FloatToStr(StrToFloat(Grid4.Cells[j,i]) / sum); + end; + Op2Edit.Text := MatFourEdit.Text; + end; + end; + + if ScriptOp = false then + begin + prmptstr := 'Save normalized vectors matrix as: '; + defaultstr := 'normalvectors'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'normalvectors'; + if Length(info) > 0 then + begin + Op3Edit.Text := ':' + IntToStr(CurrentGrid) + '-' + info; + end + else begin + Op3Edit.Text := 'normalvectors'; + info := 'normalvecs'; + end; + case CurrentGrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + opstr := IntToStr(CurrentGrid) + '-'; + Op2Edit.Text := ExtractFileName(Op2Edit.Text); + opstr := opstr + 'NormalizeCols:' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(CurrentGrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 1; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + end; +end; + +procedure TMatManFrm.NormRowsMnuClick(Sender: TObject); +var + i, j : integer; + sum : double; + prmptstr, info : string; + defaultstr : string; + clickedok : boolean; +begin + case CurrentGrid of + 1 : for i := 1 to Grid1.RowCount - 1 do + begin + sum := 0.0; + for j := 1 to Grid1.ColCount - 1 do + begin + sum := sum + sqr(StrToFloat(Grid1.Cells[j,i])); + end; + sum := sqrt(sum); + for j := 1 to Grid1.ColCount - 1 do + begin + Grid1.Cells[j,i] := FloatToStr(StrToFloat(Grid1.Cells[j,i]) / sum); + end; + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : for i := 1 to Grid2.RowCount - 1 do + begin + sum := 0.0; + for j := 1 to Grid2.ColCount - 1 do + begin + sum := sum + sqr(StrToFloat(Grid2.Cells[j,i])); + end; + sum := sqrt(sum); + for j := 1 to Grid2.ColCount - 1 do + begin + Grid2.Cells[j,i] := FloatToStr(StrToFloat(Grid2.Cells[j,i]) / sum); + end; + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : for i := 1 to Grid3.RowCount - 1 do + begin + sum := 0.0; + for j := 1 to Grid3.ColCount - 1 do + begin + sum := sum + sqr(StrToFloat(Grid3.Cells[j,i])); + end; + sum := sqrt(sum); + for j := 1 to Grid3.ColCount - 1 do + begin + Grid3.Cells[j,i] := FloatToStr(StrToFloat(Grid3.Cells[j,i]) / sum); + end; + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : for i := 1 to Grid4.RowCount - 1 do + begin + sum := 0.0; + for j := 1 to Grid4.ColCount - 1 do + begin + sum := sum + sqr(StrToFloat(Grid4.Cells[j,i])); + end; + sum := sqrt(sum); + for j := 1 to Grid4.ColCount - 1 do + begin + Grid4.Cells[j,i] := FloatToStr(StrToFloat(Grid4.Cells[j,i]) / sum); + end; + Op2Edit.Text := MatFourEdit.Text; + end; + end; + if ScriptOp = false then + begin + prmptstr := 'Save normalized rows matrix as: '; + defaultstr := 'RowNormMat'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'RowNormMat'; + if Length(info) > 0 then + begin + Op3Edit.Text := info; + end + else begin + Op3Edit.Text := 'RowNormMat'; + info := 'RowNormMat'; + end; + opstr := IntToStr(CurrentGrid) + '-'; + opstr := opstr + 'NormalizeRows:' + IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(CurrentGrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 1; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case CurrentGrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; +end; + +procedure TMatManFrm.OpenFileMnuClick(Sender: TObject); +begin + OpenDialog1.Filter := 'Matrix (*.mat)|*.MAT|Col.Vector (*.CVE)|*.CVE|RowVector (*.RVE)|*.RVE|Scaler (*.scl)|*.SCA|All (*.*)|*.*'; + OpenDialog1.FilterIndex := CurrentObjType; + case CurrentObjType of + 1 : OpenDialog1.DefaultExt := '.MAT'; + 2 : OpenDialog1.DefaultExt := '.CVE'; + 3 : OpenDialog1.DefaultExt := '.RVE'; + 4 : OpenDialog1.DefaultExt := '.SCA'; + else OpenDialog1.DefaultExt := '.MAT'; + end; + GridNoEdit.Text := IntToStr(CurrentGrid); + GetGridData(CurrentGrid); +end; + +procedure TMatManFrm.PostColVMnuClick(Sender: TObject); +// postmultiplication of a matrix by a column vector +var + i, j, k : integer; + precols, postcols, prerows, postrows : integer; + info : string; + pregrid, postgrid, resultgrid : integer; + prmptstr : string; + premat, postmat, prodmat : DynMat; + clickedok : boolean; + defaultstr : string; + +begin + if ScriptOp = false then + begin + prmptstr := 'Multiply the pre-matrix in grid '; + info := InputBox('PRE MATRIX',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + pregrid := StrToInt(info); + prmptstr := 'By the post-vector in grid '; + info := inputbox('POST VECTOR',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + postgrid := StrToInt(info); + info := inputbox('RESULTS INTO','Place results in grid :','3'); + if info = '' then exit; + resultgrid := StrToInt(info); + end + else begin // executing the script + pregrid := 1; + postgrid := 2; + resultgrid := 3; + end; + case pregrid of + 1 : begin + precols := Cols1; + prerows := Rows1; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : begin + precols := Cols2; + prerows := Rows2; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + precols := Cols3; + prerows := Rows3; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + precols := Cols4; + prerows := Rows4; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op2Edit.Text := MatFourEdit.Text; + end; + end; + case postgrid of + 1 : begin + postcols := Cols1; + postrows := Rows1; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op3Edit.Text := MatOneEdit.Text; + end; + 2 : begin + postcols := Cols2; + postrows := Rows2; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op3Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + postcols := Cols3; + postrows := Rows3; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op3Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + postcols := Cols4; + postrows := Rows4; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op3Edit.Text := MatFourEdit.Text; + end; + end; + SetLength(prodmat,prerows,postcols); + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + for k := 0 to precols-1 do + prodmat[i,j] := prodmat[i,j] + (premat[i,k]*postmat[k,j]); + case resultgrid of + 1 : begin + Grid1.RowCount := prerows+1; + Grid1.ColCount := postcols+1; + Rows1 := prerows; + Cols1 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid1.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + end; + 2 : begin + Grid2.RowCount := prerows+1; + Grid2.ColCount := postcols+1; + Rows2 := prerows; + Cols2 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid2.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + end; + 3 : begin + Grid3.RowCount := prerows+1; + Grid3.ColCount := postcols+1; + Rows3 := prerows; + Cols3 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid3.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + end; + 4 : begin + Grid4.RowCount := prerows+1; + Grid4.ColCount := postcols+1; + Rows4 := prerows; + Cols4 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid4.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + end; + end; + Op1Edit.Text := 'PreMatxPostVec'; + if ScriptOp = false then + begin + prmptstr := 'Save product vector as: '; + defaultstr := 'MatxVec'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'MatxVec'; + if Length(info) > 0 then Op4Edit.Text := info + else Op4Edit.Text := 'MatxVec'; + Op2Edit.Text := ExtractFileName(Op2Edit.Text); + Op3Edit.Text := ExtractFileName(Op3Edit.Text); + opstr := IntToStr(CurrentGrid) + '-'; + opstr := opstr + 'PreMatxPostVec:' + IntToStr(pregrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(postgrid) + '-' + Op3Edit.Text; + opstr := opstr + ':' + IntToStr(resultgrid) + '-' + Op4Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 2; + CurrentGrid := resultgrid; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case resultgrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; + // deallocate memory + prodmat := nil; + postmat := nil; + premat := nil; +end; + +procedure TMatManFrm.PostMatMnuClick(Sender: TObject); +begin + PreMatMnuClick(Self); +end; + +procedure TMatManFrm.PrebyRowVmnuClick(Sender: TObject); +// premultiplication of a matrix by a row vector +var + i, j, k : integer; + precols, postcols, prerows, postrows : integer; + info : string; + pregrid, postgrid, resultgrid : integer; + prmptstr : string; + premat, postmat, prodmat : DynMat; + clickedok : boolean; + defaultstr : string; + +begin + if ScriptOp = false then + begin + prmptstr := 'The row vector is in grid: '; + info := InputBox('VECTOR GRID',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + pregrid := StrToInt(info); + prmptstr := 'The post-matrix is in grid:'; + info := inputbox('POST MATRIX',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + postgrid := StrToInt(info); + info := inputbox('RESULTS INTO','Place results in grid :','3'); + if info = '' then exit; + resultgrid := StrToInt(info); + end + else begin // executing the script + pregrid := 1; + postgrid := 2; + resultgrid := 3; + end; + case pregrid of // row vector + 1 : begin + precols := Cols1; + prerows := Rows1; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : begin + precols := Cols2; + prerows := Rows2; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + precols := Cols3; + prerows := Rows3; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + precols := Cols4; + prerows := Rows4; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op2Edit.Text := MatFourEdit.Text; + end; + end; + case postgrid of + 1 : begin + postcols := Cols1; + postrows := Rows1; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op3Edit.Text := MatOneEdit.Text; + end; + 2 : begin + postcols := Cols2; + postrows := Rows2; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op3Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + postcols := Cols3; + postrows := Rows3; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op3Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + postcols := Cols4; + postrows := Rows4; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op3Edit.Text := MatFourEdit.Text; + end; + end; + SetLength(prodmat,prerows,postcols); + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + for k := 0 to precols-1 do + prodmat[i,j] := prodmat[i,j] + (premat[i,k]*postmat[k,j]); + case resultgrid of + 1 : begin + Grid1.RowCount := prerows+1; + Grid1.ColCount := postcols+1; + Rows1 := prerows; + Cols1 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid1.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols1 do Grid1.Cells[i,0] := 'Col.' + IntToStr(i); + MatOneEdit.Text := 'Product'; + Op4Edit.Text := MatOneEdit.Text; + end; + 2 : begin + Grid2.RowCount := prerows+1; + Grid2.ColCount := postcols+1; + Rows2 := prerows; + Cols2 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid2.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols2 do Grid2.Cells[i,0] := 'Col.' + IntToStr(i); + MatTwoEdit.Text := 'Product'; + Op4Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + Grid3.RowCount := prerows+1; + Grid3.ColCount := postcols+1; + Rows3 := prerows; + Cols3 := postrows; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid3.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols3 do Grid3.Cells[i,0] := 'Col.' + IntToStr(i); + MatThreeEdit.Text := 'Product'; + Op4Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + Grid4.RowCount := prerows+1; + Grid4.ColCount := postcols+1; + Rows4 := prerows; + Cols4 := postrows; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid4.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols4 do Grid4.Cells[i,0] := 'Col.' + IntToStr(i); + MatFourEdit.Text := 'Product'; + Op4Edit.Text := MatFourEdit.Text; + end; + end; + Op1Edit.Text := 'PreVecxPostMat'; + if ScriptOp = false then + begin + prmptstr := 'Save product as: '; + defaultstr := 'RowxMat'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'RowxMat'; + if Length(info) > 0 then Op4Edit.Text := info + else begin + Op4Edit.Text := 'RowxMat'; + info := 'RowxMat'; + end; + opstr := IntToStr(CurrentGrid) + '-'; + Op2Edit.Text := ExtractFileName(Op2Edit.Text); + opstr := opstr + 'PreVecxPostMat:' + IntToStr(pregrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(postgrid) + '-' + ExtractFileName(Op3Edit.Text); + opstr := opstr + ':' + IntToStr(resultgrid) + '-' + ExtractFileName(Op4Edit.Text); + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 3; + CurrentGrid := resultgrid; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case resultgrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; + // deallocate memory + prodmat := nil; + postmat := nil; + premat := nil; +end; + +procedure TMatManFrm.PreMatMnuClick(Sender: TObject); +// premultiplication of a matrix by another matrix +var + i, j, k : integer; + precols, postcols, prerows, postrows : integer; + info : string; + pregrid, postgrid, resultgrid : integer; + prmptstr : string; + premat, postmat, prodmat : DynMat; + clickedok : boolean; + defaultstr : string; + +begin + if ScriptOp = false then + begin + prmptstr := 'Multiply the pre-matrix in grid '; + info := InputBox('PRE MAT GRID',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + pregrid := StrToInt(info); + prmptstr := 'Times the post-matrix in grid'; + info := InputBox('POST MAT GRID',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + postgrid := StrToInt(info); + info := inputbox('RESULTS INTO','Place results in grid :','3'); + if info = '' then exit; + resultgrid := StrToInt(info); + end + else begin // executing the script + pregrid := 1; + postgrid := 2; + resultgrid := 3; + end; + case pregrid of + 1 : begin + precols := Cols1; + prerows := Rows1; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : begin + precols := Cols2; + prerows := Rows2; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + precols := Cols3; + prerows := Rows3; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + precols := Cols4; + prerows := Rows4; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op2Edit.Text := MatFourEdit.Text; + end; + end; + case postgrid of + 1 : begin + postcols := Cols1; + postrows := Rows1; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op3Edit.Text := MatOneEdit.Text; + end; + 2 : begin + postcols := Cols2; + postrows := Rows2; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op3Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + postcols := Cols3; + postrows := Rows3; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op3Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + postcols := Cols4; + postrows := Rows4; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op3Edit.Text := MatFourEdit.Text; + end; + end; + + SetLength(prodmat,prerows,postcols); + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + for k := 0 to precols-1 do + prodmat[i,j] := prodmat[i,j] + (premat[i,k]*postmat[k,j]); + + case resultgrid of + 1 : begin + Grid1.RowCount := prerows+1; + Grid1.ColCount := postcols+1; + Rows1 := prerows; + Cols1 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid1.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to prerows do Grid1.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to postcols do Grid1.Cells[i,0] := 'Col.' + IntToStr(i); + end; + 2 : begin + Grid2.RowCount := prerows+1; + Grid2.ColCount := postcols+1; + Rows2 := prerows; + Cols2 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid2.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to prerows do Grid2.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to postcols do Grid2.Cells[i,0] := 'Col.' + IntToStr(i); + end; + 3 : begin + Grid3.RowCount := prerows+1; + Grid3.ColCount := postcols+1; + Rows3 := prerows; + Cols3 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid3.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to prerows do Grid3.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to postcols do Grid3.Cells[i,0] := 'Col.' + IntToStr(i); + end; + 4 : begin + Grid4.RowCount := prerows+1; + Grid4.ColCount := postcols+1; + Rows4 := prerows; + Cols4 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid4.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to prerows do Grid4.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to postcols do Grid4.Cells[i,0] := 'Col.' + IntToStr(i); + end; + end; + Op1Edit.Text := 'PreMatxPostMat'; + if ScriptOp = false then + begin + prmptstr := 'Save result as: '; + defaultstr := 'MatxMat'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'MatxMat'; + if Length(info) > 0 then + begin + Op4Edit.Text := info; + Op4Edit.Text := IntToStr(resultgrid) + '-' + Op4Edit.Text; + end + else Op4Edit.Text := ''; + opstr := IntToStr(CurrentGrid) + '-'; + Op2Edit.Text := ExtractFileName(Op2Edit.Text); + Op2Edit.Text := IntToStr(pregrid) + '-' + Op2Edit.Text; + opstr := opstr + 'PreMatxPostMat:'+ Op2Edit.Text; + Op3Edit.Text := ExtractFileName(Op3Edit.Text); + Op3Edit.Text := IntToStr(postgrid) + '-' + Op3Edit.Text; + opstr := opstr + ':' + Op3Edit.Text; + if Length(info) > 0 then opstr := opstr + ':' + Op4Edit.Text; + ScriptList.Items.Add(opstr); + if Length(info) > 0 then + begin + case resultgrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + CurrentObjName := info; + CurrentObjType := 1; + CurrentGrid := resultgrid; + if clickedok then SaveFileMnuClick(Self); + end; + ComboAdd(CurrentObjName); + end; + // deallocate memory + prodmat := nil; + postmat := nil; + premat := nil; +end; + +procedure TMatManFrm.PreScalarMnuClick(Sender: TObject); +// premultiplication of a matrix by a scaler +var + i, j : integer; + precols, postcols, prerows, postrows : integer; + info : string; + pregrid, postgrid, resultgrid : integer; + prmptstr : string; + premat, postmat, prodmat : DynMat; + clickedok : boolean; + defaultstr : string; + +begin + if ScriptOp = false then + begin + prmptstr := 'The scalar is in grid: '; + info := InputBox('SCALAR GRID',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + pregrid := StrToInt(info); + prmptstr := 'The matrix is in grid: '; + info := InputBox('MATRIX GRID',prmptstr,IntToStr(CurrentGrid)); + postgrid := StrToInt(info); + info := inputbox('RESULTS INTO','Place results in grid :','3'); + if info = '' then exit; + resultgrid := StrToInt(info); + end + else begin // executing the script + pregrid := 1; + postgrid := 2; + resultgrid := 3; + end; + case pregrid of + 1 : begin + precols := Cols1; + prerows := Rows1; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op2Edit.Text := ExtractFileName(MatOneEdit.Text); + end; + 2 : begin + precols := Cols2; + prerows := Rows2; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op2Edit.Text := ExtractFileName(MatTwoEdit.Text); + end; + 3 : begin + precols := Cols3; + prerows := Rows3; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op2Edit.Text := ExtractFileName(MatThreeEdit.Text); + end; + 4 : begin + precols := Cols4; + prerows := Rows4; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op2Edit.Text := ExtractFileName(MatFourEdit.Text); + end; + end; + case postgrid of + 1 : begin + postcols := Cols1; + postrows := Rows1; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op3Edit.Text := ExtractFileName(MatOneEdit.Text); + end; + 2 : begin + postcols := Cols2; + postrows := Rows2; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op3Edit.Text := ExtractFileName(MatTwoEdit.Text); + end; + 3 : begin + postcols := Cols3; + postrows := Rows3; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op3Edit.Text := ExtractFileName(MatThreeEdit.Text); + end; + 4 : begin + postcols := Cols4; + postrows := Rows4; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op3Edit.Text := ExtractFileName(MatFourEdit.Text); + end; + end; + SetLength(prodmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + prodmat[i,j] := premat[0,0]*postmat[i,j]; + case resultgrid of + 1 : begin + Grid1.RowCount := postrows+1; + Grid1.ColCount := postcols+1; + Rows1 := postrows; + Cols1 := postcols; + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + Grid1.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols1 do Grid1.Cells[i,0] := 'Col.' + IntToStr(i); + MatOneEdit.Text := 'Product'; + end; + 2 : begin + Grid2.RowCount := postrows+1; + Grid2.ColCount := postcols+1; + Rows2 := postrows; + Cols2 := postcols; + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + Grid2.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols2 do Grid2.Cells[i,0] := 'Col.' + IntToStr(i); + MatTwoEdit.Text := 'Product'; + end; + 3 : begin + Grid3.RowCount := postrows+1; + Grid3.ColCount := postcols+1; + Rows3 := postrows; + Cols3 := postcols; + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + Grid3.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols3 do Grid3.Cells[i,0] := 'Col.' + IntToStr(i); + MatThreeEdit.Text := 'Product'; + end; + 4 : begin + Grid4.RowCount := postrows+1; + Grid4.ColCount := postcols+1; + Rows4 := postrows; + Cols4 := postcols; + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + Grid4.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols4 do Grid4.Cells[i,0] := 'Col.' + IntToStr(i); + MatFourEdit.Text := 'Product'; + end; + end; + Op1Edit.Text := 'ScalerxPostMat'; + opstr := IntToStr(CurrentGrid) + '-'; + opstr := opstr + 'ScalerxPostMat:' + IntToStr(pregrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(postgrid) + '-' + Op3Edit.Text; + if ScriptOp = false then + begin + prmptstr := 'Save product as: '; + defaultstr := 'ScalarxMat'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'ScalarxMat'; + if Length(info) > 0 then + begin + Op4Edit.Text := info; + end + else begin + Op4Edit.Text := 'ScalerxMat'; + info := 'ScalarxMat'; + end; + opstr := opstr + ':' + IntToStr(resultgrid) + '-' + Op4Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 1; + CurrentGrid := resultgrid; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case resultgrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; + // deallocate memory + prodmat := nil; + postmat := nil; + premat := nil; +end; + +procedure TMatManFrm.PrintFileMnuClick(Sender: TObject); +begin + MatPrintMnuClick(self); +end; + +procedure TMatManFrm.PrintScalMnuClick(Sender: TObject); +begin + MatPrintMnuClick(self); +end; + +procedure TMatManFrm.ExitMnuClick(Sender: TObject); +begin + Matrix1 := nil; + Matrix2 := nil; + Matrix3 := nil; + Matrix4 := nil; + Close; +end; + +procedure TMatManFrm.ExtractColVecMnuClick(Sender: TObject); +var + i, excol, togrid : integer; + prmptstr, info, collabel : string; + clickedok : boolean; + defaultstr : string; +begin + case CurrentGrid of + 1 : begin + Op2Edit.Text := MatOneEdit.Text; + excol := Grid1.Col; + prmptstr := 'Extract which column (1 - ' + IntToStr(excol) + ')?'; + info := InputBox('EXTRACT',prmptstr,IntToStr(excol)); + excol := StrToInt(info); + collabel := Grid1.Cells[excol,0]; + prmptstr := 'Place vector into grid '; + info := InputBox('GRID?',prmptstr,'2'); + togrid := StrToInt(info); + case togrid of + 2 : begin + Grid2.RowCount := Grid1.RowCount; + Grid2.ColCount := 2; + end; + 3 : begin + Grid3.RowCount := Grid1.RowCount; + Grid3.ColCount := 2; + end; + 4: begin + Grid4.RowCount := Grid1.RowCount; + Grid4.ColCount := 2; + end; + end; + for i := 1 to rows1 do + begin + case togrid of + 2 : Grid2.Cells[1,i] := Grid1.Cells[excol,i]; + 3 : Grid3.Cells[1,i] := Grid1.Cells[excol,i]; + 4 : Grid4.Cells[1,i] := Grid1.Cells[excol,i]; + end; + end; + case togrid of + 2 : begin + Grid2.Cells[1,0] := collabel; + Grid2.RowCount := Grid1.RowCount; + Rows2 := Grid2.RowCount - 1; + Grid2.ColCount := 2; + Cols2 := 1; + MatTwoEdit.Text := 'ExtractVec'; + Op3Edit.Text := 'ExtractVec'; + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Case' + IntToStr(i); + end; + 3 : begin + Grid3.Cells[1,0] := collabel; + Grid3.RowCount := Grid1.RowCount; + Rows3 := Grid3.RowCount - 1; + Grid3.ColCount := 2; + Cols3 := 1; + MatThreeEdit.Text := 'ExtractVec'; + Op3Edit.Text := 'ExtractVec'; + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Case' + IntToStr(i); + end; + 4 : begin + Grid4.Cells[1,0] := collabel; + Grid4.RowCount := Grid1.RowCount; + Rows4 := Grid4.RowCount - 1; + Grid4.ColCount := 2; + Cols4 := 1; + MatFourEdit.Text := 'ExtractVec'; + Op3Edit.Text := 'ExtractVec'; + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Case' + IntToStr(i); + end; + end; // end case togrid + end; // end case currentgrid = 1 + 2 : begin + Op2Edit.Text := MatTwoEdit.Text; + excol := Grid2.Col; + prmptstr := 'Extract which column (1 - ' + IntToStr(excol) + ')?'; + info := InputBox('EXTRACT',prmptstr,IntToStr(excol)); + excol := StrToInt(info); + collabel := Grid2.Cells[excol,0]; + prmptstr := 'Place vector into grid '; + info := InputBox('GRID?',prmptstr,'3'); + togrid := StrToInt(info); + case togrid of + 3 : begin + Grid3.RowCount := Grid2.RowCount; + Grid3.ColCount := 2; + end; + 4 : begin + Grid4.RowCount := Grid2.RowCount; + Grid4.ColCount := 2; + end; + 1: begin + Grid1.RowCount := Grid2.RowCount; + Grid1.ColCount := 2; + end; + end; + for i := 1 to rows2 do + begin + case togrid of + 3 : Grid3.Cells[1,i] := Grid2.Cells[excol,i]; + 4 : Grid4.Cells[1,i] := Grid2.Cells[excol,i]; + 1 : Grid1.Cells[1,i] := Grid2.Cells[excol,i]; + end; + end; + case togrid of + 3 : begin + Grid3.Cells[1,0] := collabel; + Grid3.RowCount := Grid2.RowCount; + Rows3 := Grid3.RowCount - 1; + Grid3.ColCount := 2; + Cols3 := 1; + MatThreeEdit.Text := 'ExtractVec'; + Op3Edit.Text := 'ExtractVec'; + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Case' + IntToStr(i); + end; + 4 : begin + Grid4.Cells[1,0] := collabel; + Grid4.RowCount := Grid2.RowCount; + Rows4 := Grid4.RowCount - 1; + Grid4.ColCount := 2; + Cols4 := 1; + MatFourEdit.Text := 'ExtractVec'; + Op3Edit.Text := 'ExtractVec'; + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Case' + IntToStr(i); + end; + 1 : begin + Grid1.Cells[1,0] := collabel; + Grid1.RowCount := Grid2.RowCount; + Rows1 := Grid1.RowCount - 1; + Grid1.ColCount := 2; + Cols1 := 1; + MatOneEdit.Text := 'ExtractVec'; + Op3Edit.Text := 'ExtractVec'; + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Case' + IntToStr(i); + end; + end; + end; + 3 : begin + Op2Edit.Text := MatThreeEdit.Text; + excol := Grid3.Col; + prmptstr := 'Extract which column (1 - ' + IntToStr(excol) + ')?'; + info := InputBox('EXTRACT',prmptstr,IntToStr(excol)); + excol := StrToInt(info); + collabel := Grid3.Cells[excol,0]; + prmptstr := 'Place vector into grid '; + info := InputBox('GRID?',prmptstr,'4'); + togrid := StrToInt(info); + case togrid of + 4 : begin + Grid4.RowCount := Grid3.RowCount; + Grid4.ColCount := 2; + end; + 1 : begin + Grid1.RowCount := Grid3.RowCount; + Grid1.ColCount := 2; + end; + 2: begin + Grid2.RowCount := Grid3.RowCount; + Grid2.ColCount := 2; + end; + end; + for i := 1 to rows3 do + begin + case togrid of + 4 : Grid4.Cells[1,i] := Grid3.Cells[excol,i]; + 1 : Grid1.Cells[1,i] := Grid3.Cells[excol,i]; + 2 : Grid2.Cells[1,i] := Grid3.Cells[excol,i]; + end; + end; + case togrid of + 4 : begin + Grid4.Cells[1,0] := collabel; + Grid4.RowCount := Grid3.RowCount; + Rows4 := Grid4.RowCount - 1; + Grid4.ColCount := 2; + Cols4 := 1; + MatFourEdit.Text := 'ExtractVec'; + Op3Edit.Text := 'ExtractVec'; + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Case' + IntToStr(i); + end; + 1 : begin + Grid1.Cells[1,0] := collabel; + Grid1.RowCount := Grid3.RowCount; + Rows1 := Grid1.RowCount - 1; + Grid1.ColCount := 2; + Cols1 := 1; + MatOneEdit.Text := 'ExtractVec'; + Op3Edit.Text := 'ExtractVec'; + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Case' + IntToStr(i); + end; + 2 : begin + Grid2.Cells[1,0] := collabel; + Grid2.RowCount := Grid3.RowCount; + Rows2 := Grid2.RowCount - 1; + Grid2.ColCount := 2; + Cols2 := 1; + MatTwoEdit.Text := 'ExtractVec'; + Op3Edit.Text := 'ExtractVec'; + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Case' + IntToStr(i); + end; + end; + end; + 4 : begin + Op2Edit.Text := MatFourEdit.Text; + excol := Grid4.Col; + prmptstr := 'Extract which column (1 - ' + IntToStr(excol) + ')?'; + info := InputBox('EXTRACT',prmptstr,IntToStr(excol)); + excol := StrToInt(info); + collabel := Grid4.Cells[excol,0]; + prmptstr := 'Place vector into grid '; + info := InputBox('GRID?',prmptstr,'1'); + togrid := StrToInt(info); + case togrid of + 1 : begin + Grid1.RowCount := Grid4.RowCount; + Grid1.ColCount := 2; + end; + 2 : begin + Grid2.RowCount := Grid4.RowCount; + Grid2.ColCount := 2; + end; + 3: begin + Grid3.RowCount := Grid4.RowCount; + Grid3.ColCount := 2; + end; + end; + for i := 1 to rows4 do + begin + case togrid of + 1 : Grid1.Cells[1,i] := Grid4.Cells[excol,i]; + 2 : Grid2.Cells[1,i] := Grid4.Cells[excol,i]; + 3 : Grid3.Cells[1,i] := Grid4.Cells[excol,i]; + end; + end; + case togrid of + 1 : begin + Grid1.Cells[1,0] := collabel; + Grid1.RowCount := Grid4.RowCount; + Rows1 := Grid1.RowCount - 1; + Grid1.ColCount := 2; + Cols1 := 1; + MatOneEdit.Text := 'ExtractVec'; + Op3Edit.Text := 'ExtractVec'; + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Case' + IntToStr(i); + end; + 2 : begin + Grid2.Cells[1,0] := collabel; + Grid2.RowCount := Grid4.RowCount; + Rows2 := Grid2.RowCount - 1; + Grid2.ColCount := 2; + Cols2 := 1; + MatTwoEdit.Text := 'ExtractVec'; + Op3Edit.Text := 'ExtractVec'; + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Case' + IntToStr(i); + end; + 3 : begin + Grid3.Cells[1,0] := collabel; + Grid3.RowCount := Grid4.RowCount; + Rows3 := Grid3.RowCount - 1; + Grid3.ColCount := 2; + Cols3 := 1; + MatThreeEdit.Text := 'ExtractVec'; + Op3Edit.Text := 'ExtractVec'; + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Case' + IntToStr(i); + end; + end; // end case togrid = 3 + end; // end case currentgrid = 4 + end; // end case currentgrid + ColDelMnuClick(Self); + + if ScriptOp = false then + begin + prmptstr := 'Save Extracted vector as '; + defaultstr := 'ExtractVector'; + clickedok := InputQuery('VECTOR NAME',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'ExtractVector'; + if Length(info) > 0 then Op3Edit.Text := info; + opstr := IntToStr(CurrentGrid) + '-' + 'ExtractVector:'; + opstr := opstr + IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(togrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentGrid := togrid; + CurrentObjName := Op3Edit.Text; + CurrentObjType := 2; // column vector + if clickedok then SaveFileMnuClick(Self); + ComboAdd(CurrentObjName); + end; +end; + +procedure TMatManFrm.ColAugMnuClick(Sender: TObject); +var + i : integer; + prmptstr, info : string; + clickedok : boolean; + defaultstr : string; +begin + if CurrentObjType <> 1 then + begin + ShowMessage('Error - Grid does not contain a matrix.'); + exit; + end; + if CurrentGrid = 0 then exit; + case CurrentGrid of + 1 : begin + Cols1 := Cols1 + 1; + Grid1.ColCount := Cols1 + 1; + Grid1.Cells[Cols1,0] := 'Col' + IntToStr(Cols1); + for i := 1 to Rows1 do Grid1.Cells[Cols1,i] := FloatToStr(1.0); + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : begin + Cols2 := Cols2 + 1; + Grid2.ColCount := Cols2 + 1; + Grid2.Cells[Cols2,0] := 'Col' + IntToStr(Cols2); + for i := 1 to Rows2 do Grid1.Cells[Cols2,i] := FloatToStr(1.0); + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + Cols3 := Cols3 + 1; + Grid3.ColCount := Cols3 + 1; + Grid3.Cells[Cols3,0] := 'Col' + IntToStr(Cols3); + for i := 1 to Rows3 do Grid3.Cells[Cols3,i] := FloatToStr(1.0); + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + Cols4 := Cols4 + 1; + Grid4.ColCount := Cols4 + 1; + Grid4.Cells[Cols4,0] := 'Col' + IntToStr(Cols4); + for i := 1 to Rows4 do Grid4.Cells[Cols4,i] := FloatToStr(1.0); + Op2Edit.Text := MatFourEdit.Text; + end; + end; // case + Op4Edit.Text := ''; + Op1Edit.Text := 'ColAugment'; + CurrentObjType := 1; + if ScriptOp = false then + begin + prmptstr := 'Save result as: '; + defaultstr := 'ColAugMat'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'ColAugMat'; + if Length(info) > 0 then Op3Edit.Text := ':' + IntToStr(CurrentGrid) + '-' + info + else Op3Edit.Text := ''; + opstr := IntToStr(CurrentGrid) + '-'; + opstr := opstr + 'ColAugment:' + Op2Edit.Text; + opstr := opstr + Op3Edit.Text; + ScriptList.Items.Add(opstr); + if Length(info) > 0 then + begin + CurrentObjName := info; + CurrentObjType := 1; + if clickedok then SaveFileMnuClick(Self); + end; + ComboAdd(CurrentObjName); + if Length(info) > 0 then + begin + case CurrentGrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; + end; +end; + +procedure TMatManFrm.AboutMnuClick(Sender: TObject); +begin + ShowMessage('Copyright 2010 by Bill Miller'); +end; + +procedure TMatManFrm.ColDelMnuClick(Sender: TObject); +var + i, j : integer; + delcol : integer; + prmptstr, info : string; + clickedok : boolean; + defaultstr : string; +begin + if CurrentObjType <> 1 then + begin + ShowMessage('Error - Grid does not contain a matrix.'); + exit; + end; + if CurrentGrid = 0 then exit; + case CurrentGrid of + 1 : begin + delcol := Grid1.Col; + for i := delcol + 1 to Grid1.ColCount - 1 do + for j := 1 to Grid1.RowCount - 1 do + Grid1.Cells[i-1,j] := Grid1.Cells[i,j]; + Grid1.ColCount := Grid1.ColCount - 1; + Cols1 := Cols1 - 1; + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : begin + delcol := Grid2.Col; + for i := delcol + 1 to Grid2.ColCount - 1 do + for j := 1 to Grid2.RowCount - 1 do + Grid2.Cells[i-1,j] := Grid2.Cells[i,j]; + Grid2.ColCount := Grid2.ColCount - 1; + Cols2 := Cols2 - 1; + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + delcol := Grid3.Col; + for i := delcol + 1 to Grid3.ColCount - 1 do + for j := 1 to Grid3.RowCount - 1 do + Grid3.Cells[i-1,j] := Grid3.Cells[i,j]; + Grid3.ColCount := Grid3.ColCount - 1; + Cols3 := Cols3 - 1; + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + delcol := Grid4.Col; + for i := delcol + 1 to Grid4.ColCount - 1 do + for j := 1 to Grid4.RowCount - 1 do + Grid4.Cells[i-1,j] := Grid4.Cells[i,j]; + Grid4.ColCount := Grid4.ColCount - 1; + Cols4 := Cols4 - 1; + Op2Edit.Text := MatFourEdit.Text; + end; + end; + Op1Edit.Text := 'DeleteCol'; + CurrentObjType := 1; + if ScriptOp = false then + begin + prmptstr := 'Save result as: '; + defaultstr := 'ColDel'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'ColDel'; + if Length(info) > 0 then Op3Edit.Text := info + else Op3Edit.Text := 'ColDel'; + opstr := IntToStr(CurrentGrid) + '-'; + Op2Edit.Text := ExtractFileName(Op2Edit.Text); + opstr := opstr + 'DeleteCol:' + IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(CurrentGrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := Op3Edit.Text; + CurrentObjType := 1; + if clickedok then SaveFileMnuClick(Self); + ComboAdd(CurrentObjName); + case CurrentGrid of + 1 : MatOneEdit.Text := Op3Edit.Text; + 2 : MatTwoEdit.Text := Op3Edit.Text; + 3 : MatThreeEdit.Text := Op3Edit.Text; + 4 : MatFourEdit.Text := Op3Edit.Text; + end; + end; +end; + +procedure TMatManFrm.ColInstMnuClick(Sender: TObject); +var + inscol, insgrid, i, j, showresult : integer; + before : boolean; + +begin + if ColInsertFrm = nil then + Application.CreateForm(TColInsertFrm, ColInsertFrm); + + showresult := ColInsertFrm.ShowModal; + if showresult = mrCancel then exit; + insgrid := StrToInt(ColInsertFrm.GridNoEdit.Text); + if (insgrid < 1) or (insgrid > 4) then exit; + if ColInsertFrm.BeforeColEdit.Text = '' then before := false else before := true; + if before then inscol := StrToInt(ColInsertFrm.BeforeColEdit.Text) + else inscol := StrToInt(ColInsertFrm.AfterColEdit.Text); + case insgrid of + 1 : begin + Grid1.ColCount := Grid1.ColCount + 1; + if before then + begin // insert a column before inscol + for i := Cols1 downto inscol-1 do + for j := 1 to Rows1 do + Grid1.Cells[i+1,j] := Grid1.Cells[i,j]; + if inscol > 1 then + for j := 1 to Rows1 do Grid1.Cells[inscol-1,j] := '' + else for j := 1 to Rows1 do Grid1.Cells[1,j] := ''; + end + else begin // insert a row after insrow + for i := Cols1 downto inscol+1 do + for j := 1 to Rows1 do + Grid1.Cells[i+1,j] := Grid1.Cells[i,j]; + for j := 1 to Rows1 do Grid1.Cells[inscol+1,j] := '' + end; + Cols1 := Cols1 + 1; + for i := 1 to Cols1 do Grid1.Cells[i,0] := 'Col.' + IntToStr(i); + end; // end case grid 1 + 2 : begin + Grid2.ColCount := Grid2.ColCount + 1; + if before then + begin // insert a column before inscol + for i := Cols2 downto inscol-1 do + for j := 1 to Rows2 do + Grid2.Cells[i+1,j] := Grid2.Cells[i,j]; + if inscol > 1 then + for j := 1 to Rows2 do Grid2.Cells[inscol-1,j] := '' + else for j := 1 to Rows2 do Grid2.Cells[1,j] := ''; + end + else begin // insert a row after inscol + for i := Cols2 downto inscol+1 do + for j := 1 to Rows2 do + Grid2.Cells[i+1,j] := Grid2.Cells[i,j]; + for j := 1 to Rows2 do Grid2.Cells[inscol+1,j] := '' + end; + Cols2 := Cols2 + 1; + for i := 1 to Cols2 do Grid2.Cells[i,0] := 'Col.' + IntToStr(i); + end; + 3 : begin + Grid3.ColCount := Grid3.ColCount + 1; + if before then + begin // insert a column before inscol + for i := Cols3 downto inscol-1 do + for j := 1 to Rows3 do + Grid3.Cells[i+1,j] := Grid3.Cells[i,j]; + if inscol > 1 then + for j := 1 to Rows3 do Grid3.Cells[inscol-1,j] := '' + else for j := 1 to Rows3 do Grid3.Cells[1,j] := ''; + end + else begin // insert a row after inscol + for i := Cols3 downto inscol+1 do + for j := 1 to Rows3 do + Grid3.Cells[i+1,j] := Grid3.Cells[i,j]; + for j := 1 to Rows3 do Grid3.Cells[inscol+1,j] := '' + end; + Cols3 := Cols3 + 1; + for i := 1 to Cols3 do Grid3.Cells[i,0] := 'Col.' + IntToStr(i); + end; + 4 : begin + Grid4.ColCount := Grid4.ColCount + 1; + if before then + begin // insert a column before inscol + for i := Cols4 downto inscol-1 do + for j := 1 to Rows4 do + Grid4.Cells[i+1,j] := Grid4.Cells[i,j]; + if inscol > 1 then + for j := 1 to Rows4 do Grid4.Cells[inscol-1,j] := '' + else for j := 1 to Rows4 do Grid4.Cells[1,j] := ''; + end + else begin // insert a row after inscol + for i := Cols4 downto inscol+1 do + for j := 1 to Rows4 do + Grid4.Cells[i+1,j] := Grid4.Cells[i,j]; + for j := 1 to Rows4 do Grid4.Cells[inscol+1,j] := '' + end; + Cols4 := Cols4 + 1; + for i := 1 to Cols4 do Grid4.Cells[i,0] := 'Col.' + IntToStr(i); + end; + end; // case insgrid +end; + +procedure TMatManFrm.ColVecsBoxClick(Sender: TObject); +var + vecstr : string; + answer : string; + indexno : integer; + gridno : integer; + +begin + indexno := ColVecsBox.ItemIndex; + if indexno < 0 then exit; + vecstr := ColVecsBox.Items.Strings[indexno]; + answer := InputBox('PLACEMENT','Place in which Grid?','1'); + gridno := StrToInt(answer); + if ((gridno < 1) or (gridno > 4)) then + begin + ShowMessage('Error - Grid number must be between 1 and 4.'); + exit; + end; + CurrentGrid := gridno; + CurrentObjType := 2; + CurrentObjName := vecstr; + OpenDialog1.FileName := vecstr; + GetFile(Self); + ColVecsBox.Text := 'COLUMN VECTORS'; + ColVecsBox.ItemIndex := -1; +end; + +procedure TMatManFrm.ColxRowVecMnuClick(Sender: TObject); +begin + RowxColVecMnuClick(Self); +end; + +procedure TMatManFrm.DetermMnuClick(Sender: TObject); +label emsg; +var + i, j, size, nextgrid : integer; + prmptstr, info : string; + intvector : DynIntVec; + determ : double; + clickedok : boolean; + defaultstr : string; +begin + if CurrentObjType <> 1 then +emsg: + begin + ShowMessage('Error - Selected grid does not contain a symetric matrix.'); + exit; + end; + + case CurrentGrid of + 1 : begin + if Rows1 <> Cols1 then goto emsg; + size := Rows1; + Op2Edit.Text := ExtractFileName(MatOneEdit.Text); + end; + 2 : begin + if Rows2 <> Cols2 then goto emsg; + size := Rows2; + Op2Edit.Text := ExtractFileName(MatTwoEdit.Text); + end; + 3 : begin + if Rows3 <> Cols3 then goto emsg; + size := Rows3; + Op2Edit.Text := ExtractFileName(MatThreeEdit.Text); + end; + 4 : begin + if Rows4 <> Cols4 then goto emsg; + size := Rows4; + Op2Edit.Text := ExtractFileName(MatFourEdit.Text); + end; + end; + + // allocate memory + setlength(Matrix1,size,size); + setlength(intvector,size); + + // store data to be decomposed in Matrix1 + case CurrentGrid of + 1 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + nextgrid := 2; + end; + 2 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + nextgrid := 3; + end; + 3 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + nextgrid := 4; + end; + 4 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + nextgrid := 1; + end; + end; + + // decompose + LUDCMP(Matrix1,size,intvector,determ); + for i := 0 to size-1 do determ := determ * Matrix1[i,i]; + + // place results in next grid + case nextgrid of + 1 : begin + Grid1.RowCount := 2; + Grid1.ColCount := 2; + Rows1 := 1; + Cols1 := 1; + MatOneEdit.Text := 'Determinant'; + Grid1.Cells[1,1] := FloatToStr(determ); + CurrentObjName := MatOneEdit.Text; + end; + 2 : begin + Grid2.RowCount := 2; + Grid2.ColCount := 2; + Rows2 := 1; + Cols2 := 1; + MatTwoEdit.Text := 'Determinant'; + Grid2.Cells[1,1] := FloatToStr(determ); + CurrentObjName := MatTwoEdit.Text; + end; + 3 : begin + Grid3.RowCount := 2; + Grid3.ColCount := 2; + Rows3 := 1; + Cols3 := 1; + MatThreeEdit.Text := 'Determinant'; + Grid3.Cells[1,1] := FloatToStr(determ); + CurrentObjName := MatThreeEdit.Text; + end; + 4 : begin + Grid4.RowCount := 2; + Grid4.ColCount := 2; + Rows4 := 1; + Cols4 := 1; + MatFourEdit.Text := 'Determinant'; + Grid4.Cells[1,1] := FloatToStr(determ); + CurrentObjName := MatFourEdit.Text; + end; + end; + if ScriptOp = false then + begin + prmptstr := 'Save determinant as: '; + defaultstr := 'determinant'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'determinant'; + if Length(info) > 0 then Op3Edit.Text := info + else begin + Op3Edit.Text := 'determinant'; + info := 'determinant'; + end; + Op1Edit.Text := 'Determinant'; + opstr := IntToStr(CurrentGrid) + '-' + 'Determinant:'; + opstr := opstr + IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(nextgrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 4; + CurrentGrid := nextgrid; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case nextgrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; + + // deallocate memory + intvector := nil; + Matrix1 := nil; +end; + +procedure TMatManFrm.DiagtovecmnuClick(Sender: TObject); +var + i, j, size, matgrid, nextgrid : integer; + diag : DynVec; + prmptstr, info : string; + clickedok : boolean; + defaultstr : string; +label emsg; + +begin + if CurrentGrid = 0 then exit; + prmptstr := 'The matrix is in grid: '; + info := InputBox('MATRIX GRID',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + matgrid := StrToInt(info); + if CurrentObjType <> 1 then +emsg: + begin + ShowMessage('Error - Selected grid does not contain a symetric matrix.'); + exit; + end; + + case matgrid of + 1 : begin + if Rows1 <> Cols1 then goto emsg; + size := Rows1; + SetLength(diag,size); + for i := 0 to size-1 do diag[i] := StrToFloat(Grid1.Cells[i+1,i+1]); + nextgrid := 2; + Op2Edit.Text := ExtractFileName(MatOneEdit.Text); + end; + 2 : begin + if Rows2 <> Cols2 then goto emsg; + size := Rows2; + SetLength(diag,size); + for i := 0 to size-1 do diag[i] := StrToFloat(Grid2.Cells[i+1,i+1]); + nextgrid := 3; + Op2Edit.Text := ExtractFileName(MatTwoEdit.Text); + end; + 3 : begin + if Rows3 <> Cols3 then goto emsg; + size := Rows3; + SetLength(diag,size); + for i := 0 to size-1 do diag[i] := StrToFloat(Grid3.Cells[i+1,i+1]); + nextgrid := 4; + Op2Edit.Text := ExtractFileName(MatThreeEdit.Text); + end; + 4 : begin + if Rows4 <> Cols4 then goto emsg; + size := Rows4; + SetLength(diag,size); + for i := 0 to size-1 do diag[i] := StrToFloat(Grid4.Cells[i+1,i+1]); + nextgrid := 1; + Op2Edit.Text := ExtractFileName(MatFourEdit.Text); + end; + end; + + // place diagonal elements in next available grid + case nextgrid of + 1: begin + for i := 0 to size-1 do + for j := 0 to size-1 do + Grid1.Cells[j+1,i+1] := ''; + for i := 0 to size-1 do Grid1.Cells[1,i+1] := FloatToStr(diag[i]); + cols1 := 1; + rows1 := size; + Grid1.ColCount := 2; + Grid1.RowCount := size + 1; + MatOneEdit.Text := 'DiagVec'; + end; + 2: begin + for i := 0 to size-1 do + for j := 0 to size-1 do + Grid2.Cells[j+1,i+1] := ''; + for i := 0 to size-1 do Grid2.Cells[1,i+1] := FloatToStr(diag[i]); + cols2 := 1; + rows2 := size; + Grid2.ColCount := 2; + Grid2.RowCount := size + 1; + MatTwoEdit.Text := 'DiagVec'; + end; + 3: begin + for i := 0 to size-1 do + for j := 0 to size-1 do + Grid3.Cells[j+1,i+1] := ''; + for i := 0 to size-1 do Grid3.Cells[1,i+1] := FloatToStr(diag[i]); + cols3 := 1; + rows3 := size; + Grid3.ColCount := 2; + Grid3.RowCount := size + 1; + MatThreeEdit.Text := 'DiagVec'; + end; + 4: begin + for i := 0 to size-1 do + for j := 0 to size-1 do + Grid4.Cells[j+1,i+1] := ''; + for i := 0 to size-1 do Grid4.Cells[1,i+1] := FloatToStr(diag[i]); + cols4 := 1; + rows4 := size; + Grid4.ColCount := 2; + Grid4.RowCount := size + 1; + MatFourEdit.Text := 'DiagVec'; + end; + end; + + Op1Edit.Text := 'DiagToVec:'; + opstr := IntToStr(matgrid) + '-' + 'DiagToVec:'; + opstr := opstr + IntToStr(matgrid) + '-' + Op2Edit.Text; + if ScriptOp = false then + begin + prmptstr := 'Save diagonal vector as: '; + defaultstr := 'diagvec'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'diagvec'; + if Length(info) > 0 then Op3Edit.Text := info + else begin + Op3Edit.Text := 'diagvec'; + info := 'diagvec'; + end; + opstr := opstr + ':' + IntToStr(nextgrid) + '-' + info; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 2; + CurrentGrid := nextgrid; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case nextgrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; + diag := nil; +end; + +procedure TMatManFrm.EigenMnuClick(Sender: TObject); +label emsg, finish; +var + i, j, nfactors, size, choice : integer; + rootsvec, avector, bvector : DynVec; + c, trace, pcnttrace, sum : double; + prmptstr, info : string; + rootname, vectname : string; + clickedok1, clickedok2 : boolean; + defaultstr : string; +begin + if RootMethodFrm = nil then + Application.CreateForm(TRootMethodFrm, RootMethodFrm); + + if CurrentObjType <> 1 then +emsg: + begin + ShowMessage('Error - Selected grid does not contain a symetric matrix.'); + exit; + end; + case CurrentGrid of + 1 : begin + if Rows1 <> Cols1 then goto emsg; + size := Rows1; + Op2Edit.Text := ExtractFileName(MatOneEdit.Text); + end; + 2 : begin + if Rows2 <> Cols2 then goto emsg; + size := Rows2; + Op2Edit.Text := ExtractFileName(MatTwoEdit.Text); + end; + 3 : begin + if Rows3 <> Cols3 then goto emsg; + size := Rows3; + Op2Edit.Text := ExtractFileName(MatThreeEdit.Text); + end; + 4 : begin + if Rows4 <> Cols4 then goto emsg; + size := Rows4; + Op2Edit.Text := ExtractFileName(MatFourEdit.Text); + end; + end; + + // allocate memory + setlength(Matrix1,size,size); + setlength(Matrix2,size,size); + setlength(rootsvec,size); + setlength(bvector,size); + setlength(avector,size); + + // store data in Matrix1 to be analyzed + case CurrentGrid of + 1 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + end; + 2 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + end; + 3 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + end; + 4 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + end; + end; + + c := 0.0; + nfactors := size; + trace := 0.0; + sum := 0.0; + for i := 0 to size-1 do trace := trace + Matrix1[i,i]; + + // select the desired method + if rootmethodfrm.ShowModal <> mrCancel then + choice := rootmethodfrm.Choice + else goto finish; + case choice of + 1 : begin + for i := 0 to size-1 do + for j := 0 to size-1 do + Matrix2[i,j] := Matrix1[i,j]; + sevs(size,size,c,Matrix1,Matrix2,rootsvec,bvector,size); // works! (vectors not normalized) + end; + 2 : nonsymroots(Matrix1,size,nfactors,c,Matrix2, + rootsvec,bvector,trace,pcnttrace); // works (vectors not normalized) + 3 : begin + SymMatRoots(Matrix1,size,rootsvec,Matrix2); // works! (vectors normalized) + for i := 0 to size - 1 do bvector[i] := rootsvec[i] / trace * 100.0; + end; +// 4 : HOWS(size,size,size,Matrix1,rootsvec,Matrix2); + 4 : begin + xtqli(Matrix1, size, rootsvec, bvector, avector); // works! (vectors normalized) + for i := 0 to size-1 do + for j := 0 to size-1 do + Matrix2[i,j] := Matrix1[i,j]; + end; + 5 : begin + ROOTS(Matrix1,size,rootsvec,Matrix2); // works! (vectors normalized) + for i := 0 to size - 1 do bvector[i] := rootsvec[i] / trace * 100.0; + end; + end; + + for i := 0 to size-1 do sum := sum + rootsvec[i]; + pcnttrace := (trace / sum) * 100.0; + + // Place results in the four grids + Grid1.RowCount := Size + 1; // diagonal roots matrix in first grid + Grid1.ColCount := Size + 1; + Grid2.RowCount := Size + 1; // column vectors matrix in second + Grid2.Colcount := Size + 1; + Grid3.RowCount := Size + 1; // percentage vector in each root in 3 + Grid3.ColCount := 2; + Grid4.RowCount := 3; // trace and %trace in 4 + Grid4.ColCount := 2; + Rows1 := Size; + Cols1 := Size; + Rows2 := Size; + Cols2 := Size; + Rows3 := Size; + Cols3 := 1; + Rows4 := 2; + Cols4 := 1; + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols1 do Grid1.Cells[i,0] := 'Col ' + IntToStr(i); + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols2 do Grid2.Cells[i,0] := 'Col ' + IntToStr(i); + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols3 do Grid3.Cells[i,0] := 'Col ' + IntToStr(i); + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols4 do Grid4.Cells[i,0] := 'Col ' + IntToStr(i); + Grid4.Cells[0,1] := 'Trace'; + Grid4.Cells[0,2] := '%Extract'; + MatOneEdit.Text := 'Roots'; + MatTwoEdit.Text := 'vectors'; + MatThreeEdit.Text := 'RootPcnts'; + MatFourEdit.Text := 'Trace&Pcnt'; + for i := 0 to size - 1 do + begin + for j := 0 to size - 1 do + begin + if i = j then + begin + Grid1.Cells[i+1,i+1] := FloatToStr(rootsvec[i]); + end + else Grid1.Cells[j+1,i+1] := FloatToStr(0.0); + end; + end; + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Grid2.Cells[j+1,i+1] := FloatToStr(Matrix2[i,j]); + for i := 0 to size - 1 do Grid3.Cells[1,i+1] := FloatToStr(bvector[i]); + Grid4.Cells[1,1] := FloatToStr(trace); + Grid4.Cells[1,2] := FloatToStr(pcnttrace); + Op1Edit.Text := 'MatrixRoots'; + opstr := IntToStr(CurrentGrid) + '-'; + opstr := opstr + 'MatrixRoots:' + IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + + if ScriptOp = false then + begin + prmptstr := 'Save roots diagonal matrix as: '; + defaultstr := 'roots'; + clickedok1 := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok1 then info := defaultstr else info := 'roots'; + if Length(info) > 0 then rootname := info + else rootname := 'roots'; + prmptstr := 'Save eigenvectors as: '; + defaultstr := 'eigenvectors'; + clickedok2 := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok2 then info := defaultstr else info := 'eigenvectors'; + if Length(info) > 0 then vectname := info + else vectname := 'eigenvectors'; + MatOneEdit.Text := rootname; + MatTwoEdit.Text := vectname; + opstr := opstr + ':' + IntToStr(1) + '-' + rootname; + opstr := opstr + ':' + IntToStr(2) + '-' + vectname; + ScriptList.Items.Add(opstr); + // save roots + CurrentObjName := rootname; + CurrentObjType := 1; + CurrentGrid := 1; + MatOneEdit.Text := rootname; + ComboAdd(CurrentObjName); + if clickedok1 then SaveFileMnuClick(Self); + // save vectors + CurrentObjName := vectname; + CurrentObjType := 1; + CurrentGrid := 2; + ComboAdd(CurrentObjName); + if clickedok2 then SaveFileMnuClick(Self); + MatTwoEdit.Text := vectname; + end; +finish: + // deallocate memory + avector := nil; + bvector := nil; + Matrix2 := nil; + Matrix1 := nil; + rootsvec := nil; +end; + +procedure TMatManFrm.ResetMnuClick(Sender: TObject); +begin + FormShow(Self); +end; + +procedure TMatManFrm.RowAugMnuClick(Sender: TObject); +var + i : integer; + prmptstr, info, defaultstr : string; + clickedok : boolean; +begin + if CurrentObjType <> 1 then + begin + ShowMessage('Error - Grid does not contain a matrix.'); + exit; + end; + if CurrentGrid = 0 then exit; + case CurrentGrid of + 1 : begin + Rows1 := Rows1 + 1; + Grid1.RowCount := Rows1 + 1; + Grid1.Cells[0,Rows1] := 'Row' + IntToStr(Rows1); + for i := 1 to Cols1 do Grid1.Cells[i,Rows1] := FloatToStr(1.0); + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : begin + Rows2 := Rows2 + 1; + Grid2.RowCount := Rows2 + 1; + Grid2.Cells[0,Rows2] := 'Row' + IntToStr(Rows2); + for i := 1 to Cols2 do Grid2.Cells[i,Rows2] := FloatToStr(1.0); + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + Rows3 := Rows3 + 1; + Grid3.RowCount := Rows3 + 1; + Grid3.Cells[0,Rows3] := 'Row' + IntToStr(Rows3); + for i := 1 to Cols3 do Grid3.Cells[i,Rows3] := FloatToStr(1.0); + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + Rows4 := Rows4 + 1; + Grid4.RowCount := Rows4 + 1; + Grid4.Cells[0,Rows4] := 'Row' + IntToStr(Rows4); + for i := 1 to Cols4 do Grid4.Cells[i,Rows4] := FloatToStr(1.0); + Op2Edit.Text := MatFourEdit.Text; + end; + end; // case + Op1Edit.Text := 'RowAugment'; + CurrentObjType := 1; + opstr := IntToStr(CurrentGrid) + '-'; + Op2Edit.Text := ExtractFileName(Op2Edit.Text); + opstr := opstr + 'RowAugment:' + Op2Edit.Text; + if ScriptOp = false then + begin + prmptstr := 'Save result as: '; + defaultstr := 'RowAugMat'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'RowAugMat'; + if Length(info) > 0 then Op3Edit.Text := info + else Op3Edit.Text := 'RowAugMat'; + case CurrentGrid of + 1 : MatOneEdit.Text := Op3Edit.Text; + 2 : MatTwoEdit.Text := Op3Edit.Text; + 3 : MatThreeEdit.Text := Op3Edit.Text; + 4 : MatFourEdit.Text := Op3Edit.Text; + end; + opstr := opstr + ':' + IntToStr(CurrentGrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := Op3Edit.Text; + CurrentObjType := 1; + if clickedok then SaveFileMnuClick(Self); + ComboAdd(CurrentObjName); + end; +end; + +procedure TMatManFrm.RowDelMnuClick(Sender: TObject); +var + i, j : integer; + delrow : integer; + prmptstr, info, defaultstr : string; + clickedok : boolean; +begin + if CurrentObjType <> 1 then + begin + ShowMessage('Error - Grid does not contain a matrix.'); + exit; + end; + if CurrentGrid = 0 then exit; + case CurrentGrid of + 1 : begin + delrow := Grid1.Row; + for i := delrow + 1 to Grid1.RowCount - 1 do + for j := 1 to Grid1.ColCount - 1 do + Grid1.Cells[j,i-1] := Grid1.Cells[j,i]; + Grid1.RowCount := Grid1.RowCount - 1; + Rows1 := Rows1 - 1; + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : begin + delrow := Grid2.Row; + for i := delrow + 1 to Grid2.RowCount - 1 do + for j := 1 to Grid2.ColCount - 1 do + Grid2.Cells[j,i-1] := Grid2.Cells[j,i]; + Grid2.RowCount := Grid2.RowCount - 1; + Rows2 := Rows2 - 1; + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + delrow := Grid3.Row; + for i := delrow + 1 to Grid3.RowCount - 1 do + for j := 1 to Grid3.ColCount - 1 do + Grid3.Cells[j,i-1] := Grid3.Cells[j,i]; + Grid3.RowCount := Grid3.RowCount - 1; + Rows3 := Rows3 - 1; + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + delrow := Grid4.Row; + for i := delrow + 1 to Grid4.RowCount - 1 do + for j := 1 to Grid4.ColCount - 1 do + Grid4.Cells[j,i-1] := Grid4.Cells[j,i]; + Grid4.RowCount := Grid4.RowCount - 1; + Rows4 := Rows4 - 1; + Op2Edit.Text := MatFourEdit.Text; + end; + end; + Op1Edit.Text := 'DeleteRow'; + CurrentObjType := 1; + if ScriptOp = false then + begin + prmptstr := 'Save result as: '; + defaultstr := 'RowDeleted'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'RowDeleted'; + if Length(info) > 0 then Op3Edit.Text := info + else Op3Edit.Text := 'RowDeleted'; + opstr := IntToStr(CurrentGrid) + '-'; + Op2Edit.Text := ExtractFileName(Op2Edit.Text); + opstr := opstr + 'DeleteRow:' + IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(CurrentGrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := Op3Edit.Text; + CurrentObjType := 1; + if clickedok then SaveFileMnuClick(Self); + ComboAdd(CurrentObjName); + case CurrentGrid of + 1 : MatOneEdit.Text := Op3Edit.Text; + 2 : MatTwoEdit.Text := Op3Edit.Text; + 3 : MatThreeEdit.Text := Op3Edit.Text; + 4 : MatFourEdit.Text := Op3Edit.Text; + end; + end; +end; + +procedure TMatManFrm.RowInstMnuClick(Sender: TObject); +var + insrow, insgrid, i, j, showresult : integer; + before : boolean; + +begin + if RowInsertFrm = nil then + Application.CreateForm(TRowInsertFrm, RowInsertFrm); + + showresult := RowInsertFrm.ShowModal; + if showresult = mrCancel then exit; + insgrid := StrToInt(RowInsertFrm.GridNoEdit.Text); + if (insgrid < 1) or (insgrid > 4) then exit; + if RowInsertFrm.BeforeEdit.Text = '' then before := false else before := true; + if before then insrow := StrToInt(RowInsertFrm.BeforeEdit.Text) + else insrow := StrToInt(RowInsertFrm.AfterEdit.Text); + case insgrid of + 1 : begin + Grid1.RowCount := Grid1.RowCount + 1; + if before then + begin // insert a row before insrow + for i := Rows1 downto insrow-1 do + for j := 1 to Cols1 do + Grid1.Cells[j,i+1] := Grid1.Cells[j,i]; + if insrow > 1 then + for j := 1 to Cols1 do Grid1.Cells[j,insrow-1] := '' + else for j := 1 to Cols1 do Grid1.Cells[j,1] := ''; + end + else begin // insert a row after insrow + for i := Rows1 downto insrow+1 do + for j := 1 to Cols1 do + Grid1.Cells[j,i+1] := Grid1.Cells[j,i]; + for j := 1 to Cols1 do Grid1.Cells[j,insrow+1] := '' + end; + Rows1 := Rows1 + 1; + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Row ' + IntToStr(i); + end; // end case grid 1 + 2 : begin + Grid2.RowCount := Grid2.RowCount + 1; + if before then + begin // insert a row before insrow + for i := Rows2 downto insrow-1 do + for j := 1 to Cols2 do + Grid2.Cells[j,i+1] := Grid2.Cells[j,i]; + if insrow > 1 then + for j := 1 to Cols2 do Grid2.Cells[j,insrow-1] := '' + else for j := 1 to Cols2 do Grid2.Cells[j,1] := ''; + end + else begin // insert a row after insrow + for i := Rows2 downto insrow+1 do + for j := 1 to Cols2 do + Grid2.Cells[j,i+1] := Grid2.Cells[j,i]; + for j := 1 to Cols2 do Grid2.Cells[j,insrow+1] := '' + end; + Rows2 := Rows2 + 1; + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Row ' + IntToStr(i); + end; + 3 : begin + Grid3.RowCount := Grid3.RowCount + 1; + if before then + begin // insert a row before insrow + for i := Rows3 downto insrow-1 do + for j := 1 to Cols3 do + Grid3.Cells[j,i+1] := Grid3.Cells[j,i]; + if insrow > 1 then + for j := 1 to Cols3 do Grid3.Cells[j,insrow-1] := '' + else for j := 1 to Cols3 do Grid3.Cells[j,1] := ''; + end + else begin // insert a row after insrow + for i := Rows3 downto insrow+1 do + for j := 1 to Cols3 do + Grid3.Cells[j,i+1] := Grid3.Cells[j,i]; + for j := 1 to Cols3 do Grid3.Cells[j,insrow+1] := '' + end; + Rows3 := Rows3 + 1; + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Row ' + IntToStr(i); + end; + 4 : begin + Grid4.RowCount := Grid4.RowCount + 1; + if before then + begin // insert a row before insrow + for i := Rows4 downto insrow-1 do + for j := 1 to Cols4 do + Grid4.Cells[j,i+1] := Grid4.Cells[j,i]; + if insrow > 1 then + for j := 1 to Cols4 do Grid4.Cells[j,insrow-1] := '' + else for j := 1 to Cols4 do Grid4.Cells[j,1] := ''; + end + else begin // insert a row after insrow + for i := Rows4 downto insrow+1 do + for j := 1 to Cols4 do + Grid4.Cells[j,i+1] := Grid4.Cells[j,i]; + for j := 1 to Cols4 do Grid4.Cells[j,insrow+1] := '' + end; + Rows4 := Rows4 + 1; + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Row ' + IntToStr(i); + end; + end; // case insgrid +end; + +procedure TMatManFrm.RowVecsBoxClick(Sender: TObject); +var + vecstr : string; + answer : string; + indexno : integer; + gridno : integer; + +begin + indexno := RowVecsBox.ItemIndex; + if indexno < 0 then exit; + vecstr := RowVecsBox.Items.Strings[indexno]; + answer := InputBox('PLACEMENT','Place in which Grid?','1'); + gridno := StrToInt(answer); + if ((gridno < 1) or (gridno > 4)) then + begin + ShowMessage('Error - Grid number must be between 1 and 4.'); + exit; + end; + CurrentGrid := gridno; + CurrentObjType := 3; + CurrentObjName := vecstr; + OpenDialog1.FileName := vecstr; + GetFile(Self); + RowVecsBox.Text := 'ROW VECTORS'; + RowVecsBox.ItemIndex := -1; +end; + +procedure TMatManFrm.RowxColVecMnuClick(Sender: TObject); +// premultiplication of a vector by another vector +var + i, j, k, resulttype : integer; + precols, postcols, prerows, postrows : integer; + info : string; + pregrid, postgrid, resultgrid : integer; + prmptstr : string; + premat, postmat, prodmat : DynMat; + clickedok : boolean; + defaultstr : string; + +begin + if ScriptOp = false then + begin + prmptstr := 'The pre-vector is in grid: '; + info := InputBox('PRE-VECTOR',prmptstr,IntToStr(CurrentGrid)); + if info = '' then exit; + pregrid := StrToInt(info); + prmptstr := 'The post-vector is in grid: '; + info := InputBox('POST-VECTOR',prmptstr,IntToStr(CurrentGrid)); + postgrid := StrToInt(info); + if info = '' then exit; + info := inputbox('RESULTS INTO','Place results in grid :','3'); + if info = '' then exit; + resultgrid := StrToInt(info); + end + else begin // executing the script + pregrid := 1; + postgrid := 2; + resultgrid := 3; + end; + case pregrid of + 1 : begin + precols := Cols1; + prerows := Rows1; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : begin + precols := Cols2; + prerows := Rows2; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + precols := Cols3; + prerows := Rows3; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + precols := Cols4; + prerows := Rows4; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op2Edit.Text := MatFourEdit.Text; + end; + end; + case postgrid of + 1 : begin + postcols := Cols1; + postrows := Rows1; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op3Edit.Text := MatOneEdit.Text; + end; + 2 : begin + postcols := Cols2; + postrows := Rows2; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op3Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + postcols := Cols3; + postrows := Rows3; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op3Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + postcols := Cols4; + postrows := Rows4; + SetLength(postmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op3Edit.Text := MatFourEdit.Text; + end; + end; + SetLength(prodmat,prerows,postcols); + if prerows > 1 then resulttype := 1 else resulttype := 4; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + for k := 0 to precols-1 do + prodmat[i,j] := prodmat[i,j] + (premat[i,k]*postmat[k,j]); + case resultgrid of + 1 : begin + Grid1.RowCount := prerows+1; + Grid1.ColCount := postcols+1; + Rows1 := prerows; + Cols1 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid1.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols1 do Grid1.Cells[i,0] := 'Col.' + IntToStr(i); + MatOneEdit.Text := 'Product'; + Op4Edit.Text := MatOneEdit.Text; + if Rows1 = Cols1 then CurrentObjType := 1; + if Rows1 > Cols1 then CurrentObjType := 2; + if Cols1 > Rows1 then CurrentObjType := 3; + end; + 2 : begin + Grid2.RowCount := prerows+1; + Grid2.ColCount := postcols+1; + Rows2 := prerows; + Cols2 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid2.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols2 do Grid2.Cells[i,0] := 'Col.' + IntToStr(i); + MatTwoEdit.Text := 'Product'; + Op4Edit.Text := MatTwoEdit.Text; + if Rows2 = Cols2 then CurrentObjType := 1; + if Rows2 > Cols2 then CurrentObjType := 2; + if Cols2 > Rows2 then CurrentObjType := 3; + end; + 3 : begin + Grid3.RowCount := prerows+1; + Grid3.ColCount := postcols+1; + Rows3 := prerows; + Cols3 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid3.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols3 do Grid3.Cells[i,0] := 'Col.' + IntToStr(i); + MatThreeEdit.Text := 'Product'; + Op4Edit.Text := MatThreeEdit.Text; + if Rows3 = Cols3 then CurrentObjType := 1; + if Rows3 > Cols3 then CurrentObjType := 2; + if Cols3 > Rows3 then CurrentObjType := 3; + end; + 4 : begin + Grid4.RowCount := prerows+1; + Grid4.ColCount := postcols+1; + Rows4 := prerows; + Cols4 := postcols; + for i := 0 to prerows-1 do + for j := 0 to postcols-1 do + Grid4.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols4 do Grid4.Cells[i,0] := 'Col.' + IntToStr(i); + MatFourEdit.Text := 'Product'; + Op4Edit.Text := MatFourEdit.Text; + if Rows4 = Cols4 then CurrentObjType := 1; + if Rows4 > Cols4 then CurrentObjType := 2; + if Cols4 > Rows4 then CurrentObjType := 3; + end; + end; + Op1Edit.Text := 'VecxVec'; + opstr := IntToStr(CurrentGrid) + '-'; + Op2Edit.Text := ExtractFileName(Op2Edit.Text); + Op2Edit.Text := IntToStr(postgrid) + '-' + Op2Edit.Text; + opstr := opstr + 'VecxVec:'+ Op2Edit.Text; + Op3Edit.Text := ExtractFileName(Op3Edit.Text); + Op3Edit.Text := IntToStr(pregrid) + '-' + Op3Edit.Text; + opstr := opstr + ':' + Op3Edit.Text; + if ScriptOp = false then + begin + prmptstr := 'Save product as: '; + defaultstr := 'VectorProd'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'VectorProd'; + if Length(info) > 0 then Op4Edit.Text := info + else begin + Op4Edit.Text := 'VectorProd'; + info := 'VectorProd'; + end; + opstr := opstr + ':' + IntToStr(resultgrid) + '-' + Op4Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := resulttype; + ComboAdd(CurrentObjName); + CurrentGrid := resultgrid; + if clickedok then SaveFileMnuClick(Self); + end; + // deallocate memory + prodmat := nil; + postmat := nil; + premat := nil; +end; + +procedure TMatManFrm.SaveFileMnuClick(Sender: TObject); +var + SaveFile : TextFile; + i, j : integer; +// OpStr : string; + BackUpName : string; + +begin + SaveDialog1.Filter := 'Matrix (*.mat)|*.MAT|Col.Vector (*.CVE)|*.CVE|RowVector (*.RVE)|*.RVE|Scaler (*.scl)|*.SCA|All (*.*)|*.*'; + SaveDialog1.FilterIndex := CurrentObjType; + case CurrentObjType of + 1 : SaveDialog1.DefaultExt := '.MAT'; + 2 : SaveDialog1.DefaultExt := '.CVE'; + 3 : SaveDialog1.DefaultExt := '.RVE'; + 4 : SaveDialog1.DefaultExt := '.SCA'; + end; + BackUpName := ExtractFileName(CurrentObjName); + SaveDialog1.FileName := BackUpName; + + if SaveDialog1.Execute then + begin + Op2Edit.Text := SaveDialog1.FileName; + CurrentObjName := ExtractFileName(SaveDialog1.FileName); + Op1Edit.Text := 'FileSave'; + Op3Edit.Text := ''; + Op4Edit.Text := ''; + AssignFile(SaveFile, SaveDialog1.FileName); + Rewrite(SaveFile); + Writeln(SaveFile,CurrentObjType); + Writeln(SaveFile,CurrentObjName); + case CurrentGrid of + 1 : begin + MatOneEdit.Text := CurrentObjName; + Writeln(SaveFile,Rows1); + Writeln(SaveFile,Cols1); + for i := 1 to Rows1 do + for j := 1 to Cols1 do + Writeln(SaveFile,Grid1.Cells[j,i]); + end; + 2 : begin + MatTwoEdit.Text := CurrentObjName; + Writeln(SaveFile,Rows2); + Writeln(SaveFile,Cols2); + for i := 1 to Rows2 do + for j := 1 to Cols2 do + Writeln(SaveFile,Grid2.Cells[j,i]); + end; + 3 : begin + MatThreeEdit.Text := CurrentObjName; + Writeln(SaveFile,Rows3); + Writeln(SaveFile,Cols3); + for i := 1 to Rows3 do + for j := 1 to Cols3 do + Writeln(SaveFile,Grid3.Cells[j,i]); + end; + 4 : begin + MatFourEdit.Text := CurrentObjName; + Writeln(SaveFile,Rows4); + Writeln(SaveFile,Cols4); + for i := 1 to Rows4 do + for j := 1 to Cols4 do + Writeln(SaveFile,Grid4.Cells[j,i]); + end; + end; // case + CloseFile(SaveFile); + Saved := true; + if ScriptOp = false then + begin + OpStr := IntToStr(CurrentGrid) + '-'; + OpStr := OpStr + 'FileSave:' + IntToStr(CurrentGrid) + '-' + CurrentObjName; + if scriptoptsfrm.CheckGroup1.Checked[1] <> true then ScriptList.Items.Add(OpStr); + end; + end; // if savedialog1 executed +end; + +procedure TMatManFrm.ScalarInmnuClick(Sender: TObject); +var + instr : string; + +begin + instr := InputBox('GRID?','Which grid no. (1-4):','1'); + CurrentGrid := StrToInt(instr); + if ((CurrentGrid < 1) or (CurrentGrid > 4)) then CurrentGrid := 1; + GridNoEdit.Text := IntToStr(CurrentGrid); + ScaCount := ScaCount + 1; + instr := InputBox('Scaler Name','Object name:','Ascaler'); + CurrentObjName := instr; + CurrentObjType := 4; + case CurrentGrid of + 1 : begin + Rows1 := 1; + Cols1 := 1; + Grid1.RowCount := 2; + Grid1.ColCount := 2; + Grid1.Cells[1,0] := 'Col.1'; + Grid1.Cells[0,1] := 'Row.1'; + Grid1.Cells[1,1] := ''; + MatOneEdit.Text := CurrentObjName; + end; + 2 : begin + Rows2 := 1; + Cols2 := 1; + Grid2.RowCount := 2; + Grid2.ColCount := 2; + Grid2.Cells[1,0] := 'Col.1'; + Grid2.Cells[0,1] := 'Row.1'; + Grid2.Cells[1,1] := ''; + MatTwoEdit.Text := CurrentObjName; + end; + 3 : begin + Rows3 := 1; + Cols3 := 1; + Grid3.RowCount := 2; + Grid3.ColCount := 2; + Grid3.Cells[1,0] := 'Col.1'; + Grid3.Cells[0,1] := 'Row.1'; + Grid3.Cells[1,1] := ''; + MatThreeEdit.Text := CurrentObjName; + end; + 4 : begin + Rows4 := 1; + Cols4 := 1; + Grid4.RowCount := 2; + Grid4.ColCount := 2; + Grid4.Cells[1,0] := 'Col.1'; + Grid4.Cells[0,1] := 'Row.1'; + Grid4.Cells[1,1] := ''; + MatFourEdit.Text := CurrentObjName; + end; + end; // case + case CurrentGrid of + 1 : Grid1.SetFocus; + 2 : Grid2.SetFocus; + 3 : Grid3.SetFocus; + 4 : Grid4.SetFocus; + end; +end; + +procedure TMatManFrm.ScalarsBoxClick(Sender: TObject); +var + scalerstr : string; + answer : string; + indexno : integer; + gridno : integer; + +begin + indexno := ScalarsBox.ItemIndex; + if indexno < 0 then exit; + scalerstr := ScalarsBox.Items.Strings[indexno]; + answer := InputBox('PLACEMENT','Place in which Grid?','1'); + gridno := StrToInt(answer); + if ((gridno < 1) or (gridno > 4)) then + begin + ShowMessage('Error - Grid number must be between 1 and 4.'); + exit; + end; + CurrentGrid := gridno; + CurrentObjType := 4; + CurrentObjName := scalerstr; + OpenDialog1.FileName := scalerstr; + GetFile(Self); + ScalarsBox.Text := 'SCALARS'; + ScalarsBox.ItemIndex := -1; +end; + +procedure TMatManFrm.ScalRecipMnuClick(Sender: TObject); +var + prmptstr, info : string; + clickedok : boolean; + defaultstr : string; +begin + Op1Edit.Text := 'ScalerRecip'; + case CurrentGrid of + 1 : begin + if StrToFloat(Grid1.Cells[1,1]) = 0.0 then + begin + ShowMessage('Attempt to divide by zero.'); + exit; + end; + Grid1.Cells[1,1] := FloatToStr(1.0 / StrToFloat(Grid1.Cells[1,1])); + Op2Edit.Text := MatOneEdit.Text; + MatOneEdit.Text := 'ScalerRecip'; + Op3Edit.Text := MatOneEdit.Text; + CurrentObjName := MatOneEdit.Text; + end; + 2 : begin + if StrToFloat(Grid2.Cells[1,1]) = 0.0 then + begin + ShowMessage('Attempt to divide by zero.'); + exit; + end; + Grid2.Cells[1,1] := FloatToStr(1.0 / StrToFloat(Grid2.Cells[1,1])); + Op2Edit.Text := MatTwoEdit.Text; + MatTwoEdit.Text := 'ScalerRecip'; + Op3Edit.Text := MatTwoEdit.Text; + CurrentObjName := MatTwoEdit.Text; + end; + 3 : begin + if StrToFloat(Grid3.Cells[1,1]) = 0.0 then + begin + ShowMessage('Attempt to divide by zero.'); + exit; + end; + Grid3.Cells[1,1] := FloatToStr(1.0 / StrToFloat(Grid3.Cells[1,1])); + Op2Edit.Text := MatThreeEdit.Text; + MatThreeEdit.Text := 'ScalerRecip'; + Op3Edit.Text := MatThreeEdit.Text; + CurrentObjName := MatThreeEdit.Text; + end; + 4 : begin + if StrToFloat(Grid4.Cells[1,1]) = 0.0 then + begin + ShowMessage('Attempt to divide by zero.'); + exit; + end; + Grid4.Cells[1,1] := FloatToStr(1.0 / StrToFloat(Grid4.Cells[1,1])); + Op2Edit.Text := MatFourEdit.Text; + MatFourEdit.Text := 'ScalerRecip'; + Op3Edit.Text := MatFourEdit.Text; + CurrentObjName := MatFourEdit.Text; + end; + end; + if ScriptOp = false then + begin + opstr := IntToStr(CurrentGrid) + '-' + 'ScalerRecip:'; + opstr := opstr + IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + prmptstr := 'Save reciprocal of scaler as: '; + defaultstr := 'ScalarRecip'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'ScalarRecip'; + if Length(info) > 0 then Op3Edit.Text := info + else begin + Op3Edit.Text := 'ScalarRecip'; + info := 'ScalarRecip'; + end; + opstr := opstr + ':' + IntToStr(CurrentGrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 4; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case CurrentGrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; +end; + +procedure TMatManFrm.ScalSqrtMnuClick(Sender: TObject); +var + prmptstr, info : string; + clickedok : boolean; + defaultstr : string; +begin + Op1Edit.Text := 'SqrtScalar'; + case CurrentGrid of + 1 : begin + if StrToFloat(Grid1.Cells[1,1]) < 0.0 then + ShowMessage('Attempt to take square root of a negative value.') + else Grid1.Cells[1,1] := FloatToStr(sqrt(StrToFloat(Grid1.Cells[1,1]))); + Op2Edit.Text := MatOneEdit.Text; + MatOneEdit.Text := 'SqrtScaler'; + end; + 2 : begin + if StrToFloat(Grid2.Cells[1,1]) < 0.0 then + ShowMessage('Attempt to take square root of a negative value.') + else Grid2.Cells[1,1] := FloatToStr(sqrt(StrToFloat(Grid2.Cells[1,1]))); + Op2Edit.Text := MatTwoEdit.Text; + MatTwoEdit.Text := 'SqrtScaler'; + end; + 3 : begin + if StrToFloat(Grid3.Cells[1,1]) < 0.0 then + ShowMessage('Attempt to take square root of a negative value.') + else Grid3.Cells[1,1] := FloatToStr(sqrt(StrToFloat(Grid3.Cells[1,1]))); + Op2Edit.Text := MatThreeEdit.Text; + MatThreeEdit.Text := 'SqrtScaler'; + end; + 4 : begin + if StrToFloat(Grid4.Cells[1,1]) < 0.0 then + ShowMessage('Attempt to take square root of a negative value.') + else Grid4.Cells[1,1] := FloatToStr(sqrt(StrToFloat(Grid4.Cells[1,1]))); + Op2Edit.Text := MatFourEdit.Text; + MatFourEdit.Text := 'SqrtScaler'; + end; + end; + if ScriptOp = false then + begin + prmptstr := 'Save scalar square root as: '; + defaultstr := 'SqrtScalar'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'SqrtScalar'; + if Length(info) > 0 then Op3Edit.Text := info + else begin + Op3Edit.Text := 'SqrtScalar'; + info := 'SqrtScaler'; + end; + opstr := IntToStr(CurrentGrid) + '-' + 'SqrtScaler:'; + opstr := opstr + IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(CurrentGrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 4; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case CurrentGrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; +end; + +procedure TMatManFrm.ScalxScalMnuClick(Sender: TObject); +var + multiplier : double; + prmptstr, info : string; + clickedok : boolean; + defaultstr : string; +begin + prmptstr := 'Multiply the scalar by ' ; + info := inputbox('MULTIPLY BY ',prmptstr,''); + if info = '' then exit + else multiplier := StrToFloat(info); + Op1Edit.Text := 'ScalarxScalar'; + case CurrentGrid of + 1 : begin + Op2Edit.Text := MatOneEdit.Text; + Grid1.Cells[1,1] := FloatToStr(StrToFloat(Grid1.Cells[1,1]) * multiplier); + MatOneEdit.Text := 'ScalarProd'; + end; + 2 : begin + Op2Edit.Text := MatTwoEdit.Text; + Grid2.Cells[1,1] := FloatToStr(StrToFloat(Grid2.Cells[1,1]) * multiplier); + MatTwoEdit.Text := 'ScalarProd'; + end; + 3 : begin + Op2Edit.Text := MatThreeEdit.Text; + Grid3.Cells[1,1] := FloatToStr(StrToFloat(Grid3.Cells[1,1]) * multiplier); + MatThreeEdit.Text := 'ScalarProd'; + end; + 4 : begin + Op2Edit.Text := MatFourEdit.Text; + Grid4.Cells[1,1] := FloatToStr(StrToFloat(Grid4.Cells[1,1]) * multiplier); + MatFourEdit.Text := 'ScalarProd'; + end; + end; + + if ScriptOp = false then + begin + prmptstr := 'Save product of scalars as: '; + defaultstr := 'ScalarProd'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'ScalarProd'; + if Length(info) > 0 then Op3Edit.Text := ':' + IntToStr(CurrentGrid) + '-' + info + else begin + Op3Edit.Text := 'ScalarProd'; + info := 'ScalarProd'; + end; + opstr := IntToStr(CurrentGrid) + '-' + 'ScalerProd:'; + opstr := opstr + IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(CurrentGrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 4; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case CurrentGrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; +end; + +procedure TMatManFrm.ScrExeMnuClick(Sender: TObject); +var + i, Count : integer; +// Operation, Op1, Op2, Op3 : string; + parseresult : integer; +// Opergrid, Op1grid, Op2grid, Op3grid : integer; +begin + Count := ScriptList.Items.Count; + if Count < 1 then + begin + ShowMessage('No script loaded to execute!'); + exit; + end; + ScriptOp := true; + for i := 0 to Count - 1 do + begin + OpStr := ScriptList.Items.Strings[i]; + + parseresult := OpParse(Operation, OpStr, Op1, Op2, Op3, Opergrid, Op1grid, + Op2grid, Op3grid); + if parseresult = 0 then + begin + ShowMessage('Operation code not found in a script entry.'); + ScriptOp := false; + exit; + end; + + // Now, execute the operation + OperExec; //(Operation, Op1, Op2, Op3, Opergrid, Op1grid, Op2grid, Op3grid); + if i = Count - 1 then ScriptOp := false; + LastScript := i; + end; // next i +end; + +procedure TMatManFrm.ScriptClearMnuClick(Sender: TObject); +begin + ScriptList.Clear; +end; + +procedure TMatManFrm.ScriptEditMnuClick(Sender: TObject); +var count, i : integer; + +begin + count := ScriptList.Items.Count; + ScriptEditorFrm.ScriptList.Clear; + for i := 0 to count-1 do ScriptEditorFrm.ScriptList.Items.Add(ScriptList.Items.Strings[i]); + ScriptEditorFrm.ShowModal; +end; + +procedure TMatManFrm.ScriptFileInMnuClick(Sender: TObject); +var + SaveFile : TextFile; + i, Count : integer; + cellstring : string; +// ScriptName : string; +begin + OpenDialog1.FileName := 'Script'; + OpenDialog1.Filter := 'Script (*.SCP)|*.SCP|(*.*)|*.*'; + OpenDialog1.DefaultExt := '.SCP'; + if OpenDialog1.Execute then + begin + ScriptName := ExtractFileName(OpenDialog1.FileName); + ScriptList.Clear; + scripteditorfrm.ScriptList.Clear; + scripteditorfrm.ScriptFileEdit.Text := OpenDialog1.FileName; + AssignFile(SaveFile, OpenDialog1.FileName); + Reset(SaveFile); + Readln(SaveFile,CurrentObjType); + if CurrentObjType <> 5 then + begin + ShowMessage('Not a script file!'); + CloseFile(SaveFile); + exit; + end; + Readln(SaveFile,CurrentObjName); + Op2Edit.Text := OpenDialog1.FileName; + Readln(SaveFile,Count); + for i := 0 to Count - 1 do + begin + Readln(SaveFile,cellstring); + ScriptList.Items.Add(cellstring); + scripteditorfrm.ScriptList.Items.Add(cellstring); + end; + CloseFile(SaveFile); + Op1Edit.Text := 'OpenScript'; + Op3Edit.Text := ''; + end; +end; + +procedure TMatManFrm.ScriptListClick(Sender: TObject); +var + i, Count : integer; + parseresult : integer; + +begin + Count := ScriptList.Items.Count; + if Count < 1 then + begin + ShowMessage('No script loaded to execute!'); + exit; + end; + ScriptOp := true; + i := ScriptList.ItemIndex; + OpStr := ScriptList.Items.Strings[i]; + parseresult := OpParse(Operation, OpStr, Op1, Op2, Op3, Opergrid, Op1grid, + Op2grid, Op3grid); + if parseresult = 0 then + begin + ShowMessage('Operation code not found in a script entry.'); + ScriptOp := false; + exit; + end; + + // Now, execute the operation + OperExec; //(Operation, Op1, Op2, Op3, Opergrid, Op1grid, Op2grid, Op3grid); + ScriptOp := false; +end; + +procedure TMatManFrm.ScriptLoadMnuClick(Sender: TObject); +begin + ScriptFileInMnuClick(Self); +end; + +procedure TMatManFrm.ScriptOpsMnuClick(Sender: TObject); +begin + ScriptOptsFrm.ShowModal; +end; + +procedure TMatManFrm.ScriptPrintMnuClick(Sender: TObject); +var i : integer; + +begin + if ScriptList.Items.Count = 0 then exit; + OutputFrm.RichEdit.Lines.Add('CURRENT LISTING FOR SCRIPT ' + ScriptName); + OutputFrm.RichEdit.Lines.Add(''); + for i := 0 to ScriptList.Items.Count - 1 do + OutputFrm.RichEdit.Lines.Add(ScriptList.Items.Strings[i]); + OutputFrm.ShowModal; +end; + +procedure TMatManFrm.ScriptSaveMnuClick(Sender: TObject); +var + SaveFile : TextFile; + i, Count : integer; + +begin + Count := ScriptList.Items.Count; + if Count < 1 then exit; + CurrentObjType := 5; // a script file + SaveDialog1.FileName := 'Script'; + SaveDialog1.Filter := 'Script (*.SCP)|*.SCP|(*.*)|*.*'; + SaveDialog1.DefaultExt := '.SCP'; + if SaveDialog1.Execute then + begin + AssignFile(SaveFile, SaveDialog1.FileName); + CurrentObjName := SaveDialog1.FileName; + Rewrite(SaveFile); + Writeln(SaveFile,CurrentObjType); + Writeln(SaveFile,CurrentObjName); + Writeln(SaveFile,Count); + for i := 0 to Count - 1 do + Writeln(SaveFile,ScriptList.Items.Strings[i]); + CloseFile(SaveFile); + Op1Edit.Text := 'SaveScript'; + Op2Edit.Text := SaveDialog1.FileName; + Op3Edit.Text := ''; + end; +end; + +procedure TMatManFrm.ScrSavMnuClick(Sender: TObject); +begin + ScriptSaveMnuClick(Self); +end; + +procedure TMatManFrm.SVDInvMnuClick(Sender: TObject); +label emsg; +var + size : integer; + i, j : integer; + prmptstr, info : string; + clickedok : boolean; + defaultstr : string; +begin + if CurrentObjType <> 1 then +emsg: + begin + ShowMessage('Error - Selected grid does not contain a symetric matrix.'); + exit; + end; + case CurrentGrid of + 1 : begin + if Rows1 <> Cols1 then goto emsg; + size := Rows1; + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : begin + if Rows2 <> Cols2 then goto emsg; + size := Rows2; + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + if Rows3 <> Cols3 then goto emsg; + size := Rows3; + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + if Rows4 <> Cols4 then goto emsg; + size := Rows4; + Op2Edit.Text := MatFourEdit.Text; + end; + end; + + // allocate memory + setlength(Matrix1,size,size); + setlength(Matrix2,size,size); + setlength(Matrix3,size,size); + setlength(Matrix4,size,size); + + case CurrentGrid of + 1 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + end; + 2 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + end; + 3 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + end; + 4 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + end; + end; + matinv(Matrix1, Matrix2, Matrix3, Matrix4, size); + + // Place results in the four grids + Grid1.RowCount := Size + 1; + Grid1.ColCount := Size + 1; + Grid2.RowCount := Size + 1; + Grid2.Colcount := Size + 1; + Grid3.RowCount := Size + 1; + Grid3.ColCount := Size + 1; + Grid4.RowCount := Size + 1; + Grid4.ColCount := Size + 1; + Rows1 := Size; + Cols1 := Size; + Rows2 := Size; + Cols2 := Size; + Rows3 := Size; + Cols3 := Size; + Rows4 := Size; + Cols4 := Size; +// Obj1NameEdit.Text := 'Inverse'; + MatTwoEdit.Text := 'vtimesw '; + MatThreeEdit.Text := 'v'; + MatFourEdit.Text := 'w'; + for i := 0 to size - 1 do + begin + for j := 0 to size - 1 do + begin + Grid1.Cells[j+1,i+1] := FloatToStr(Matrix1[i,j]); + Grid2.Cells[j+1,i+1] := FloatToStr(Matrix2[i,j]); + Grid3.Cells[j+1,i+1] := FloatToStr(Matrix3[i,j]); + Grid4.Cells[j+1,i+1] := FloatToStr(Matrix4[i,j]); + end; + end; + + Op1Edit.Text := 'SVDInverse'; + if ScriptOp = false then + begin + prmptstr := 'Save result as: '; + defaultstr := 'SVDInverse'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'SVDInverse'; + if Length(info) > 0 then MatOneEdit.Text := info; + opstr := IntToStr(CurrentGrid) + '-'; + Op2Edit.Text := ExtractFileName(Op2Edit.Text); + Op2Edit.Text := IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + opstr := opstr + 'SVDInverse:' + Op2Edit.Text; + if Length(info) > 0 then Op3Edit.Text := ':' + IntToStr(1) + '-' + info + else Op3Edit.Text := ''; + opstr := opstr + Op3Edit.Text; + ScriptList.Items.Add(opstr); + if Length(info) > 0 then + begin + CurrentObjName := info; + CurrentObjType := 1; + CurrentGrid := 1; + if clickedok then SaveFileMnuClick(Self); + end; + ComboAdd(CurrentObjName); + end; + // deallocate memory + Matrix4 := nil; + Matrix3 := nil; + Matrix2 := nil; + Matrix1 := nil; +end; + +procedure TMatManFrm.TraceMnuClick(Sender: TObject); +label emsg; +var + i, nextgrid : integer; + sum : double; + prmptstr, info : string; + clickedok : boolean; + defaultstr : string; +begin + if CurrentObjType <> 1 then +emsg: + begin + ShowMessage('Error - Selected grid does not contain a matrix.'); + exit; + end; + sum := 0.0; + + case CurrentGrid of + 1 : begin + for i := 1 to Grid1.ColCount - 1 do + sum := sum + StrToFloat(Grid1.Cells[i,i]); + Op2Edit.Text := MatOneEdit.Text; + nextgrid := 2; + end; + 2 : begin + for i := 1 to Grid2.ColCount - 1 do + sum := sum + StrToFloat(Grid2.Cells[i,i]); + Op2Edit.Text := MatTwoEdit.Text; + nextgrid := 3; + end; + 3 : begin + for i := 1 to Grid3.ColCount - 1 do + sum := sum + StrToFloat(Grid3.Cells[i,i]); + Op2Edit.Text := MatThreeEdit.Text; + nextgrid := 4; + end; + 4 : begin + for i := 1 to Grid4.ColCount - 1 do + sum := sum + StrToFloat(Grid4.Cells[i,i]); + Op2Edit.Text := MatFourEdit.Text; + nextgrid := 1; + end; + end; + + // place results in next grid + case nextgrid of + 1 : begin + Grid1.RowCount := 2; + Grid1.ColCount := 2; + MatOneEdit.Text := 'Trace'; + Grid1.Cells[1,1] := FloatToStr(sum); + CurrentObjName := MatOneEdit.Text; + end; + 2 : begin + Grid2.RowCount := 2; + Grid2.ColCount := 2; + MatTwoEdit.Text := 'Trace'; + Grid2.Cells[1,1] := FloatToStr(sum); + CurrentObjName := MatTwoEdit.Text; + end; + 3 : begin + Grid3.RowCount := 2; + Grid3.ColCount := 2; + MatThreeEdit.Text := 'Trace'; + Grid3.Cells[1,1] := FloatToStr(sum); + CurrentObjName := MatThreeEdit.Text; + end; + 4 : begin + Grid4.RowCount := 2; + Grid4.ColCount := 2; + MatFourEdit.Text := 'Trace'; + Grid4.Cells[1,1] := FloatToStr(sum); + CurrentObjName := MatFourEdit.Text; + end; + end; + + Op1Edit.Text := 'MatTrace'; + if ScriptOp = false then + begin + prmptstr := 'Save trace as: '; + defaultstr := 'trace'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'trace'; + if Length(info) > 0 then + begin + Op3Edit.Text := info; + end + else begin + Op3Edit.Text := 'trace'; + info := 'trace'; + end; + case nextgrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + Op2Edit.Text := IntToStr(CurrentGrid) + '-' + ExtractFileName(Op2Edit.Text); + opstr := IntToStr(CurrentGrid) + '-' + 'MatTrace:' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(nextgrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 4; + CurrentGrid := nextgrid; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + end; +end; + +procedure TMatManFrm.TransMnuClick(Sender: TObject); +label emsg; +var + i, j, nextgrid : integer; + prmptstr, info: string; + clickedok : boolean; + defaultstr : string; +begin + if CurrentObjType <> 1 then +emsg: + begin + ShowMessage('Error - Selected grid does not contain a matrix.'); + exit; + end; + case CurrentGrid of + 1 : begin + Op2Edit.Text := MatOneEdit.Text; + nextgrid := 2; + Grid2.RowCount := Cols1 + 1; + Grid2.ColCount := Rows1 + 1; + for i := 1 to Rows1 do + for j := 1 to Cols1 do + Grid2.Cells[i,j] := Grid1.Cells[j,i]; + for i := 1 to Rows1 do Grid2.Cells[i,0] := 'Col.' + IntToStr(i); + for i := 1 to Cols1 do Grid2.Cells[0,i] := 'Row ' + IntToStr(i); + Grid2.RowCount := Cols1 + 1; + Grid2.ColCount := Rows1 + 1; + Rows2 := Cols1; + Cols2 := Rows1; + end; + 2 : begin + Op2Edit.Text := MatTwoEdit.Text; + nextgrid := 3; + Grid3.RowCount := Cols2 + 1; + Grid3.ColCount := Rows2 + 1; + for i := 1 to Rows2 do + for j := 1 to Cols2 do + Grid3.Cells[i,j] := Grid2.Cells[j,i]; + for i := 1 to Rows2 do Grid3.Cells[i,0] := 'Col.' + IntToStr(i); + for i := 1 to Cols2 do Grid3.Cells[0,i] := 'Row ' + IntToStr(i); + Rows3 := Cols2; + Cols3 := Rows2; + end; + 3 : begin + Op2Edit.Text := MatThreeEdit.Text; + nextgrid := 4; + Grid4.RowCount := Cols3 + 1; + Grid4.ColCount := Rows3 + 1; + for i := 1 to Rows3 do + for j := 1 to Cols3 do + Grid4.Cells[i,j] := Grid3.Cells[j,i]; + for i := 1 to Rows3 do Grid4.Cells[i,0] := 'Col.' + IntToStr(i); + for i := 1 to Cols3 do Grid4.Cells[0,i] := 'Row ' + IntToStr(i); + Rows4 := Cols3; + Cols4 := Rows3; + end; + 4 : begin + Op2Edit.Text := MatFourEdit.Text; + nextgrid := 1; + Grid1.RowCount := Cols4 + 1; + Grid1.ColCount := Rows4 + 1; + for i := 1 to Rows4 do + for j := 1 to Cols4 do + Grid1.Cells[i,j] := Grid4.Cells[j,i]; + for i := 1 to Rows4 do Grid1.Cells[i,0] := 'Col.' + IntToStr(i); + for i := 1 to Cols4 do Grid1.Cells[0,i] := 'Row ' + IntToStr(i); + Rows1 := Cols4; + Cols1 := Rows4; + end; + end; + Op1Edit.Text := 'MatTranspose'; + Op4Edit.Text := ''; + if ScriptOp = false then + begin + prmptstr := 'Save transpose matrix as: '; + defaultstr := 'transpose'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'transpose'; + opstr := IntToStr(CurrentGrid) + '-'; + Op2Edit.Text := ExtractFileName(Op2Edit.Text); + Op2Edit.Text := IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + opstr := opstr + 'MatTranspose:' + Op2Edit.Text; + if Length(info) > 0 then + Op3Edit.Text := ':' + IntToStr(nextgrid) + '-' + info + else begin + Op3Edit.Text := ':' + IntToStr(nextgrid) + '-' + 'transpose'; + info := 'transpose'; + end; + opstr := opstr + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := 1; + CurrentGrid := nextgrid; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case nextgrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; +end; + +procedure TMatManFrm.TriDiagMnuClick(Sender: TObject); +label emsg; +var + size : integer; + i, j : integer; + prmptstr, info : string; + avector, bvector : DynVec; + clickedok : boolean; + defaultstr : string; +begin + if CurrentGrid = 0 then exit; + if CurrentObjType <> 1 then +emsg: + begin + ShowMessage('Error - Selected grid does not contain a symetric matrix.'); + exit; + end; + case CurrentGrid of + 1 : begin + if Rows1 <> Cols1 then goto emsg; + size := Rows1; + Op2Edit.Text := ExtractFileName(MatOneEdit.Text); + end; + 2 : begin + if Rows2 <> Cols2 then goto emsg; + size := Rows2; + Op2Edit.Text := ExtractFileName(MatTwoEdit.Text); + end; + 3 : begin + if Rows3 <> Cols3 then goto emsg; + size := Rows3; + Op2Edit.Text := ExtractFileName(MatThreeEdit.Text); + end; + 4 : begin + if Rows4 <> Cols4 then goto emsg; + size := Rows4; + Op2Edit.Text := ExtractFileName(MatFourEdit.Text); + end; + end; + + // allocate memory + setlength(Matrix1,size,size); + setlength(Matrix2,size,size); + setlength(avector,size); + setlength(bvector,size); + + // store data in Matrix1 to be inverted + case CurrentGrid of + 1 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + end; + 2 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + end; + 3 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + end; + 4 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + end; + end; + TRED2(Matrix1,size,avector,bvector); + for i := 0 to size-1 do + begin + for j := 0 to size-1 do + begin + Matrix2[i,j] := 0.0; + if i = j then Matrix2[i,j] := avector[i]; + if i < size-1 then Matrix2[i,i+1] := bvector[i+1]; + if i > 0 then Matrix2[i,i-1] := bvector[i]; + end; + end; + + // Replace original matrix with tridiagonalized matrix + case CurrentGrid of + 1 : begin + for i := 0 to size-1 do + for j := 0 to size-1 do + Grid1.Cells[j+1,i+1] := FloatToStr(Matrix2[i,j]); + end; + 2 : begin + for i := 0 to size-1 do + for j := 0 to size-1 do + Grid2.Cells[j+1,i+1] := FloatToStr(Matrix2[i,j]); + end; + 3 : begin + for i := 0 to size-1 do + for j := 0 to size-1 do + Grid3.Cells[j+1,i+1] := FloatToStr(Matrix2[i,j]); + end; + 4 : begin + for i := 0 to size-1 do + for j := 0 to size-1 do + Grid4.Cells[j+1,i+1] := FloatToStr(Matrix2[i,j]); + end; + end; + + Op1Edit.Text := 'Tridiagonalize'; + opstr := IntToStr(CurrentGrid) + '-'; + Op2Edit.Text := Op2Edit.Text; + opstr := opstr + 'Tridiagonalize:' + IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + if ScriptOp = false then + begin + prmptstr := 'Save result as: '; + defaultstr := 'TriDiag'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'TriDiag'; + if Length(info) > 0 then Op3Edit.Text := info + else Op3Edit.Text := 'TriDiag'; + opstr := opstr + ':' + IntToStr(CurrentGrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := Op3Edit.Text; + CurrentObjType := 1; + if clickedok then SaveFileMnuClick(Self); + case CurrentGrid of + 1 : MatOneEdit.Text := Op3Edit.Text; + 2 : MatTwoEdit.Text := Op3Edit.Text; + 3 : MatThreeEdit.Text := Op3Edit.Text; + 4 : MatFourEdit.Text := Op3Edit.Text; + end; + ComboAdd(CurrentObjName); + end; + // deallocate memory + Matrix4 := nil; + Matrix3 := nil; + avector := nil; + bvector := nil; +end; + +procedure TMatManFrm.ULDecompMnuClick(Sender: TObject); +label emsg; +var + size : integer; + i, j : integer; + prmptstr, info : string; + intvector : DynIntVec; + scaler : double; + lowername, uppername : string; + clickedok1, clickedok2 : boolean; + defaultstr : string; +begin + if CurrentGrid = 0 then exit; + if CurrentObjType <> 1 then +emsg: + begin + ShowMessage('Error - Selected grid does not contain a symetric matrix.'); + exit; + end; + case CurrentGrid of + 1 : begin + if Rows1 <> Cols1 then goto emsg; + size := Rows1; + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : begin + if Rows2 <> Cols2 then goto emsg; + size := Rows2; + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + if Rows3 <> Cols3 then goto emsg; + size := Rows3; + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + if Rows4 <> Cols4 then goto emsg; + size := Rows4; + Op2Edit.Text := MatFourEdit.Text; + end; + end; + + // allocate memory + setlength(Matrix1,size,size); + setlength(Matrix2,size,size); + setlength(Matrix3,size,size); + setlength(Matrix4,size,size); + setlength(intvector,size); + + // store data to be decomposed in Matrix1 + case CurrentGrid of + 1 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + end; + 2 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + end; + 3 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + end; + 4 : begin + for i := 0 to size - 1 do + for j := 0 to size - 1 do + Matrix1[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + end; + end; + + // decompose + LUDCMP(Matrix1,size,intvector,scaler); + for i := 0 to size-1 do + for j := 0 to size-1 do + Matrix2[i,j] := Matrix1[i,j]; + { store in left and right triangular matrices } + for i := 0 to size-1 do + begin + for j := 0 to size-1 do + begin + Matrix3[i,j] := 0.0; + Matrix4[i,j] := 0.0; + end; + end; + for i := 0 to size-1 do // row + begin + for j := 0 to i do + Matrix3[i,j] := Matrix2[i,j]; // lower matrix + Matrix3[i,i] := 1.0; + end; + for i := 0 to size -1 do + for j := i to Size-1 do + Matrix4[i,j] := Matrix2[i,j]; // upper matrix + + // Place lower in grid1 + Grid1.RowCount := size + 1; + Grid1.ColCount := size + 1; + Rows1 := size; + Cols1 := size; + for i := 0 to size-1 do + for j := 0 to size-1 do + Grid1.Cells[j+1,i+1] := FloatToStr(Matrix3[i,j]); + MatOneEdit.Text := 'LowerDecomp'; + // place upper in grid2 + Grid2.RowCount := size + 1; + Grid2.ColCount := size + 1; + Rows2 := size; + Cols2 := size; + for i := 0 to size-1 do + for j := 0 to size-1 do + Grid2.Cells[j+1,i+1] := FloatToStr(Matrix4[i,j]); + MatTwoEdit.Text := 'UpperDecomp'; + //save combined upper and lower in grid3 + Grid3.RowCount := size + 1; + Grid3.ColCount := size + 1; + Rows3 := size; + Cols3 := size; + for i := 0 to size - 1 do + for j := 0 to size-1 do + Grid3.Cells[j+1,i+1] := FloatToStr(Matrix2[i,j]); + MatThreeEdit.Text := 'LUMatrix'; + // save permutations in grid4 + grid4.RowCount := size + 1; + Grid4.ColCount := 2; + Rows4 := size; + Cols4 := 1; + for i := 0 to size-1 do Grid4.Cells[1,i+1] := IntToStr(intvector[i] + 1); + MatFourEdit.Text := 'RowPermutations'; + + Op1Edit.Text := 'UpLowDecomp'; + opstr := IntToStr(CurrentGrid) + '-'; + Op2Edit.Text := ExtractFileName(Op2Edit.Text); + opstr := opstr + 'UpLowDecomp:' + IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + if ScriptOp = false then + begin + prmptstr := 'Save lower matrix as: '; + defaultstr := 'lowermat'; + clickedok1 := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok1 then info := defaultstr else info := 'lowermat'; + if Length(info) > 0 then lowername := info + else lowername := 'lowermat'; + prmptstr := 'Save upper matrix as: '; + defaultstr := 'uppermat'; + clickedok2 := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok2 then info := defaultstr else info := 'uppermat'; + if Length(info) > 0 then uppername := info + else uppername := 'uppermat'; + opstr := opstr + ':' + IntToStr(1) + '-' + lowername; + opstr := opstr + ':' + IntToStr(2) + '-' + uppername; + ScriptList.Items.Add(opstr); + CurrentObjName := lowername; + CurrentObjType := 1; + CurrentGrid := 1; + MatOneEdit.Text := lowername; + ComboAdd(CurrentObjName); + if clickedok1 then SaveFileMnuClick(Self); + CurrentObjName := uppername; + CurrentObjType := 1; + CurrentGrid := 2; + MatTwoEdit.Text := uppername; + ComboAdd(CurrentObjName); + if clickedok2 then SaveFileMnuClick(Self); + end; + // deallocate memory + intvector := nil; + Matrix4 := nil; + Matrix3 := nil; + Matrix2 := nil; + Matrix1 := nil; +end; + +procedure TMatManFrm.Vec2DiagMnuClick(Sender: TObject); +var + i, vecgrid, matgrid : integer; + info, prmptstr : string; +begin + if scriptop = true then + begin + vecgrid := 1; + matgrid := 2; + end + else begin + prmptstr := 'Insert the vector from grid '; + info := InputBox('VECTOR GRID',prmptstr,IntToStr(CurrentGrid)); + vecgrid := StrToInt(info); + prmptstr := 'into the matrix diagonal in grid '; + info := InputBox('MATRIX GRID',prmptstr,IntToStr(CurrentGrid)); + matgrid := StrToInt(info); + end; + case vecgrid of + 1 : Op2Edit.Text := MatOneEdit.Text; + 2 : Op2Edit.Text := MatTwoEdit.Text; + 3 : Op2Edit.Text := MatThreeEdit.Text; + 4 : Op2Edit.Text := MatFourEdit.Text; + end; + + case matgrid of + 1 : begin + Op3Edit.Text := MatOneEdit.Text; + case vecgrid of + 2 : begin + if Rows2 > Cols2 then + for i := 1 to Rows2 do Grid1.Cells[i,i] := Grid2.Cells[1,i] + else for i := 1 to Cols2 do Grid1.Cells[i,i] := Grid2.Cells[i,1]; + end; + 3 : begin + if Rows3 > Cols3 then + for i := 1 to Rows3 do Grid1.Cells[i,i] := Grid3.Cells[1,i] + else for i := 1 to Cols3 do Grid1.Cells[i,i] := Grid3.Cells[i,1]; + end; + 4 : begin + if Rows4 > Cols4 then + for i := 1 to Rows4 do Grid1.Cells[i,i] := Grid4.Cells[1,i] + else for i := 1 to Cols4 do Grid1.Cells[i,i] := Grid4.Cells[i,1]; + end; + end; + end; + 2 : begin + Op3Edit.Text := MatTwoEdit.Text; + case vecgrid of + 1 : begin + if Rows1 > Cols1 then + for i := 1 to Rows1 do Grid2.Cells[i,i] := Grid1.Cells[1,i] + else for i := 1 to Cols1 do Grid2.Cells[i,i] := Grid1.Cells[i,1]; + end; + 3 : begin + if Rows3 > Cols3 then + for i := 1 to Rows3 do Grid2.Cells[i,i] := Grid3.Cells[1,i] + else for i := 1 to Cols3 do Grid2.Cells[i,i] := Grid3.Cells[i,1]; + end; + 4 : begin + if Rows4 > Cols4 then + for i := 1 to Rows4 do Grid2.Cells[i,i] := Grid4.Cells[1,i] + else for i := 1 to Cols4 do Grid2.Cells[i,i] := Grid4.Cells[i,1]; + end; + end; + end; + 3 : begin + Op3Edit.Text := MatThreeEdit.Text; + case vecgrid of + 1 : begin + if Rows1 > Cols1 then + for i := 1 to Rows1 do Grid3.Cells[i,i] := Grid1.Cells[1,i] + else for i := 1 to Cols1 do Grid3.Cells[i,i] := Grid1.Cells[i,1]; + end; + 2 : begin + if Rows2 > Cols2 then + for i := 1 to Rows2 do Grid3.Cells[i,i] := Grid2.Cells[1,i] + else for i := 1 to Cols2 do Grid3.Cells[i,i] := Grid2.Cells[i,1]; + end; + 4 : begin + if Rows4 > Cols4 then + for i := 1 to Rows4 do Grid3.Cells[i,i] := Grid4.Cells[1,i] + else for i := 1 to Cols4 do Grid3.Cells[i,i] := Grid4.Cells[i,1]; + end; + end; + end; + 4 : begin + Op3Edit.Text := MatFourEdit.Text; + case vecgrid of + 1 : begin + if Rows1 > Cols1 then + for i := 1 to Rows1 do Grid4.Cells[i,i] := Grid1.Cells[1,i] + else for i := 1 to Cols1 do Grid4.Cells[i,i] := Grid1.Cells[i,1]; + end; + 2 : begin + if Rows2 > Cols2 then + for i := 1 to Rows2 do Grid4.Cells[i,i] := Grid2.Cells[1,i] + else for i := 1 to Cols2 do Grid4.Cells[i,i] := Grid2.Cells[i,1]; + end; + 3 : begin + if Rows3 > Cols3 then + for i := 1 to Rows3 do Grid4.Cells[i,i] := Grid3.Cells[1,i] + else for i := 1 to Cols3 do Grid4.Cells[i,i] := Grid3.Cells[i,1]; + end; + end; + end; + end; // case matgrid + Op1Edit.Text := 'VecToDiag'; + + if scriptop = false then + begin + opstr := IntToStr(CurrentGrid) + '-' + 'VecToDiag:'; + Op2Edit.Text := IntToStr(vecgrid) + '-' + Op2Edit.Text; + opstr := opstr + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(matgrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentGrid := matgrid; + CurrentObjName := Op3Edit.Text; + CurrentObjType := 1; // column vector + SaveFileMnuClick(Self); + ComboAdd(CurrentObjName); + end; +end; + +procedure TMatManFrm.VecInmnuClick(Sender: TObject); +var + instr : string; + i, j : integer; + +begin + instr := InputBox('GRID?','Which grid no. (1-4):','1'); + CurrentGrid := StrToInt(instr); + if ((CurrentGrid < 1) or (CurrentGrid > 4)) then CurrentGrid := 1; + GridNoEdit.Text := IntToStr(CurrentGrid); + instr := InputBox('TYPE','Row or Column Vector','Column'); + if instr = 'Column' then CurrentObjType := 2 else CurrentObjType := 3; + if CurrentObjType = 3 then // row vector + begin + instr := InputBox('NAME','Object name:','ARowVector'); + CurrentObjName := instr; + Rows := 1; + instr := InputBox('RowVector','No. of elements = ','3'); + Cols := StrToInt(instr); + RowVecCount := RowVecCount + 1; + RowVecsBox.Items.Add(CurrentObjName); + case CurrentGrid of + 1 : begin + Rows1 := Rows; + Cols1 := Cols; + Grid1.ColCount := Cols1 + 1; + Grid1.RowCount := 2; + MatOneEdit.Text := CurrentObjName; + for i := 0 to Rows1 do + for j := 0 to Cols1 do + Grid1.Cells[j,i] := ''; + for i := 1 to Cols1 do Grid1.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Row' + IntToStr(i); + end; + 2 : begin + Rows2 := Rows; + Cols2 := Cols; + Grid2.ColCount := Cols2 + 1; + Grid2.RowCount := 2; + MatTwoEdit.Text := CurrentObjName; + for i := 0 to Rows2 do + for j := 0 to Cols2 do + Grid2.Cells[j,i] := ''; + for i := 1 to Cols2 do Grid2.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Row' + IntToStr(i); + end; + 3 : begin + Rows3 := Rows; + Cols3 := Cols; + Grid3.ColCount := Cols3 + 1; + Grid3.RowCount := 2; + MatThreeEdit.Text := CurrentObjName; + for i := 0 to Rows3 do + for j := 0 to Cols3 do + Grid3.Cells[j,i] := ''; + for i := 1 to Cols3 do Grid3.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Row' + IntToStr(i); + end; + 4 : begin + Rows4:= Rows; + Cols4:= Cols; + Grid4.ColCount := Cols4+ 1; + Grid4.RowCount := 2; + MatFourEdit.Text := CurrentObjName; + for i := 0 to Rows4 do + for j := 0 to Cols4 do + Grid4.Cells[j,i] := ''; + for i := 1 to Cols4 do Grid4.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Row' + IntToStr(i); + end; + end; // case + Op1Edit.Text := 'RowVecInput'; + Op2Edit.Text := CurrentObjName; + Op3Edit.Text := ''; + end + else // column vector input + begin + instr := InputBox('NAME','Object name:','AColVector'); + CurrentObjName := instr; + Cols := 1; + instr := InputBox('ColumnVector','No. of elements = ','3'); + Rows := StrToInt(instr); + case CurrentGrid of + 1 : begin + MatOneEdit.Text := CurrentObjName; + Cols1 := Cols; + Rows1 := Rows; + Grid1.ColCount := 2; + Grid1.RowCount := Rows1 + 1; + for i := 0 to Rows1 do + for j := 0 to Cols1 do + Grid1.Cells[j,i] := ''; + for i := 1 to Cols1 do Grid1.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Row' + IntToStr(i); + end; + 2 : begin + MatTwoEdit.Text := CurrentObjName; + Cols2 := Cols; + Rows2 := Rows; + Grid2.ColCount := 2; + Grid2.RowCount := Rows2 + 1; + for i := 0 to Rows2 do + for j := 0 to Cols2 do + Grid2.Cells[j,i] := ''; + for i := 1 to Cols2 do Grid2.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Row' + IntToStr(i); + end; + 3 : begin + MatThreeEdit.Text := CurrentObjName; + Cols3 := Cols; + Rows3 := Rows; + Grid3.ColCount := 2; + Grid3.RowCount := Rows3 + 1; + for i := 0 to Rows3 do + for j := 0 to Cols3 do + Grid3.Cells[j,i] := ''; + for i := 1 to Cols3 do Grid3.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Row' + IntToStr(i); + end; + 4 : begin + MatFourEdit.Text := CurrentObjName; + Cols4 := Cols; + Rows4 := Rows; + Grid4.ColCount := 2; + Grid4.RowCount := Rows4 + 1; + for i := 0 to Rows4 do + for j := 0 to Cols4 do + Grid4.Cells[j,i] := ''; + for i := 1 to Cols4 do Grid4.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Row' + IntToStr(i); + end; + end; // case + ColVecCount := ColVecCount + 1; + ColVecsBox.Items.Add(CurrentObjName); + Op1Edit.Text := 'ColVecInput'; + Op2Edit.Text := CurrentObjName; + Op3Edit.Text := ''; + end; + case CurrentGrid of + 1 : Grid1.SetFocus; + 2 : Grid2.SetFocus; + 3 : Grid3.SetFocus; + 4 : Grid4.SetFocus; + end; +end; + +procedure TMatManFrm.VecPrintMnuClick(Sender: TObject); +begin + MatPrintMnuClick(Self); +end; + +procedure TMatManFrm.VecRecipMnuClick(Sender: TObject); +var + vectype, i, j : integer; + prmptstr, info, priorobjname : string; + clickedok : boolean; + defaultstr : string; +begin + CurrentObjName := 'VectorRecips'; + case Currentgrid of + 1 : begin + priorobjname := MatOneEdit.Text; + if Rows1 > Cols1 then vectype := 2 else vectype := 3; + for i := 1 to Rows1 do + begin + for j := 1 to Cols1 do + begin + if StrToFloat(Grid1.Cells[j,i]) = 0.0 then + ShowMessage('ERROR - attempt to divide by zero!') + else + Grid1.Cells[j,i] := FloatToStr(1.0 /StrToFloat(Grid1.Cells[j,i])); + end; + end; + MatOneEdit.Text := CurrentObjName; + end; + 2 : begin + priorobjname := MatTwoEdit.Text; + if Rows2 > Cols2 then vectype := 2 else vectype := 3; + for i := 1 to Rows2 do + begin + for j := 1 to Cols2 do + begin + if StrToFloat(Grid2.Cells[j,i]) = 0.0 then + ShowMessage('ERROR - attempt to divide by zero!') + else + Grid2.Cells[j,i] := FloatToStr(1.0 /StrToFloat(Grid2.Cells[j,i])); + end; + end; + MatTwoEdit.Text := CurrentObjName; + end; + 3 : begin + priorobjname := MatThreeEdit.Text; + if Rows3 > Cols3 then vectype := 2 else vectype := 3; + for i := 1 to Rows3 do + begin + for j := 1 to Cols3 do + begin + if StrToFloat(Grid3.Cells[j,i]) = 0.0 then + ShowMessage('ERROR - attempt to divide by zero!') + else + Grid3.Cells[j,i] := FloatToStr(1.0 /StrToFloat(Grid3.Cells[j,i])); + end; + end; + MatThreeEdit.Text := CurrentObjName; + end; + 4 : begin + priorobjname := MatFourEdit.Text; + if Rows4 > Cols4 then vectype := 2 else vectype := 3; + for i := 1 to Rows4 do + begin + for j := 1 to Cols4 do + begin + if StrToFloat(Grid4.Cells[j,i]) = 0.0 then + ShowMessage('ERROR - attempt to divide by zero!') + else + Grid4.Cells[j,i] := FloatToStr(1.0 /StrToFloat(Grid4.Cells[j,i])); + end; + end; + MatFourEdit.Text := CurrentObjName; + end; + end; // end case + + if ScriptOp = false then + begin + opstr := IntToStr(Currentgrid) + '-' + 'VectorRecip:'; + opstr := opstr + IntToStr(Currentgrid) + '-' + priorobjname; + prmptstr := 'Save recipricol of vector as: '; + defaultstr := 'VectorRecip'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'VectorRecip'; + if Length(info) > 0 then Op3Edit.Text := info + else begin + Op3Edit.Text := 'VectorRecip'; + info := 'VectorRecip'; + end; + opstr := opstr + ':' + IntToStr(CurrentGrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := vectype; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + end; +end; + +procedure TMatManFrm.VecSqrtMnuClick(Sender: TObject); +var + vectype, i, j : integer; + prmptstr, info, priorobjname : string; + clickedok : boolean; + defaultstr : string; +begin + CurrentObjName := 'sqrtvector'; + case Currentgrid of + 1 : begin + priorobjname := MatOneEdit.Text; + if ExtractFileExt(priorobjname) = '.RVE' then vectype := 3 else vectype := 2; + for i := 1 to Rows1 do + begin + for j := 1 to Cols1 do + begin + if StrToFloat(Grid1.Cells[j,i]) < 0.0 then + ShowMessage('ERROR - attempt to take root of a negative value!') + else + Grid1.Cells[j,i] := FloatToStr(sqrt(abs(StrToFloat(Grid1.Cells[j,i])))); + end; + end; + MatOneEdit.Text := CurrentObjName; + end; + 2 : begin + priorobjname := MatTwoEdit.Text; + if ExtractFileExt(priorobjname) = '.RVE' then vectype := 3 else vectype := 2; + for i := 1 to Rows2 do + begin + for j := 1 to Cols2 do + begin + if StrToFloat(Grid2.Cells[j,i]) < 0.0 then + ShowMessage('ERROR - attempt to take root of a negative value!') + else + Grid2.Cells[j,i] := FloatToStr(sqrt(abs(StrToFloat(Grid2.Cells[j,i])))); + end; + end; + MatTwoEdit.Text := CurrentObjName; + end; + 3 : begin + priorobjname := MatThreeEdit.Text; + if ExtractFileExt(priorobjname) = '.RVE' then vectype := 3 else vectype := 2; + for i := 1 to Rows3 do + begin + for j := 1 to Cols3 do + begin + if StrToFloat(Grid3.Cells[j,i]) < 0.0 then + ShowMessage('ERROR - attempt to take root of a negative value!') + else + Grid3.Cells[j,i] := FloatToStr(sqrt(abs(StrToFloat(Grid3.Cells[j,i])))); + end; + end; + MatThreeEdit.Text := CurrentObjName; + end; + 4 : begin + priorobjname := MatFourEdit.Text; + if ExtractFileExt(priorobjname) = '.RVE' then vectype := 3 else vectype := 2; + for i := 1 to Rows4 do + begin + for j := 1 to Cols4 do + begin + if StrToFloat(Grid4.Cells[j,i]) < 0.0 then + ShowMessage('ERROR - attempt to take root of a negative value!') + else + Grid4.Cells[j,i] := FloatToStr(sqrt(abs(StrToFloat(Grid4.Cells[j,i])))); + end; + end; + MatFourEdit.Text := CurrentObjName; + end; + end; // end case + + if ScriptOp = false then + begin + prmptstr := 'Save square root of vector as: '; + defaultstr := 'SqrtVec'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'SqrtVec'; + if Length(info) > 0 then + begin + Op3Edit.Text := ':' + IntToStr(CurrentGrid) + '-' + info; + end + else begin + Op3Edit.Text := 'SqrtVec'; + info := 'SqrtVec'; + end; + opstr := IntToStr(Currentgrid) + '-' + 'sqrtvector:'; + opstr := opstr + IntToStr(Currentgrid) + '-' + priorobjname; + opstr := opstr + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := vectype; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case CurrentGrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; +end; + +procedure TMatManFrm.VecTransMnuClick(Sender: TObject); +label emsg; +var + i, j, transgrid, vectype : integer; + prmptstr, info : string; + clickedok : boolean; + defaultstr : string; +begin + if CurrentGrid = 0 then exit; + if ((CurrentObjType = 1) or (CurrentObjType = 4)) then +emsg: + begin + ShowMessage('Error - Selected grid does not contain a vector.'); + exit; + end; + if ScriptOp = true then CurrentGrid := 1; + transgrid := CurrentGrid + 1; + if transgrid > 4 then transgrid := 1; + case CurrentGrid of + 1 : begin + Op2Edit.Text := MatOneEdit.Text; + // get type of resulting vector + if Rows1 = 1 then vectype := 2 else vectype := 3; + Grid2.RowCount := Grid1.ColCount; + Grid2.ColCount := Grid1.RowCount; + Rows2 := Grid2.RowCount-1; + Cols2 := Grid2.ColCount-1; + MatTwoEdit.Text := 'VectorTrans'; + for i := 1 to rows1 do + for j := 1 to cols1 do + Grid2.Cells[i,j] := Grid1.Cells[j,i]; + end; + 2 : begin + Op2Edit.Text := MatTwoEdit.Text; + if Rows2 = 1 then vectype := 2 else vectype := 3; + Grid3.RowCount := Grid2.ColCount; + Grid3.ColCount := Grid2.RowCount; + Rows3 := Grid3.RowCount-1; + Cols3 := Grid3.ColCount-1; + MatThreeEdit.Text := 'VectorTrans'; + for i := 1 to rows2 do + for j := 1 to cols2 do + Grid3.Cells[i,j] := Grid2.Cells[j,i]; + end; + 3 : begin + Op2Edit.Text := MatThreeEdit.Text; + if Rows3 = 1 then vectype := 2 else vectype := 3; + Grid4.RowCount := Grid3.ColCount; + Grid4.ColCount := Grid3.RowCount; + Rows4 := Grid4.RowCount-1; + Cols4 := Grid4.ColCount-1; + MatFourEdit.Text := 'VectorTrans'; + for i := 1 to rows3 do + for j := 1 to cols3 do + Grid4.Cells[i,j] := Grid3.Cells[j,i]; + end; + 4 : begin + Op2Edit.Text := MatFourEdit.Text; + if Rows4 = 1 then vectype := 2 else vectype := 3; + Grid1.RowCount := Grid4.ColCount; + Grid1.ColCount := Grid4.RowCount; + Rows1 := Grid4.RowCount-1; + Cols1 := Grid4.ColCount-1; + MatOneEdit.Text := 'VectorTrans'; + for i := 1 to rows4 do + for j := 1 to cols4 do + Grid1.Cells[i,j] := Grid4.Cells[j,i]; + end; + end; + Op1Edit.Text := 'Vec.Transpose'; + opstr := IntToStr(CurrentGrid) + '-' + 'VectorTranspose:'; + opstr := opstr + IntToStr(CurrentGrid) + '-' + Op2Edit.Text; + if ScriptOp = false then + begin + prmptstr := 'Save vector transpose as: '; + defaultstr := 'VecTrans'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'VecTrans'; + if Length(info) > 0 then + begin + Op3Edit.Text := info; + end + else begin + Op3Edit.Text := 'VecTrans'; + info := 'VecTrans'; + end; + opstr := opstr + ':' + IntToStr(transgrid) + '-' + Op3Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := vectype; + CurrentGrid := transgrid; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case transgrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; +end; + +procedure TMatManFrm.VecXscalarMnuClick(Sender: TObject); +// multiplication of a scaler times a vector +var + i, j, vectype : integer; + precols, postcols, prerows, postrows : integer; + info : string; + pregrid, postgrid, resultgrid : integer; + prmptstr : string; + premat, postmat, prodmat : DynMat; + clickedok : boolean; + defaultstr : string; +begin + if ScriptOp = false then + begin + prmptstr := 'The scaler is in grid ' + IntToStr(CurrentGrid); + info := inputbox('SCALER',prmptstr,'2'); + if info = '' then exit; + pregrid := StrToInt(info); + prmptstr := 'The vector is in grid ' + IntToStr(CurrentGrid); + info := inputbox('VECTOR',prmptstr,'2'); + if info = '' then exit; + postgrid := StrToInt(info); + info := inputbox('RESULTS INTO','Place results in grid :','3'); + if info = '' then exit; + resultgrid := StrToInt(info); + end + else begin // executing the script + pregrid := 1; + postgrid := 2; + resultgrid := 3; + end; + case pregrid of + 1 : begin + precols := Cols1; + prerows := Rows1; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op2Edit.Text := MatOneEdit.Text; + end; + 2 : begin + precols := Cols2; + prerows := Rows2; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op2Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + precols := Cols3; + prerows := Rows3; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op2Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + precols := Cols4; + prerows := Rows4; + SetLength(premat,prerows,precols); + for i := 0 to prerows-1 do + for j := 0 to precols-1 do + premat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op2Edit.Text := MatFourEdit.Text; + end; + end; + case postgrid of + 1 : begin + postcols := Cols1; + postrows := Rows1; + SetLength(postmat,postrows,postcols); + if Cols1 > Rows1 then vectype := 3 else vectype := 2; + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid1.Cells[j+1,i+1]); + Op3Edit.Text := MatOneEdit.Text; + end; + 2 : begin + postcols := Cols2; + postrows := Rows2; + SetLength(postmat,postrows,postcols); + if Cols2 > Rows2 then vectype := 3 else vectype := 2; + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid2.Cells[j+1,i+1]); + Op3Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + postcols := Cols3; + postrows := Rows3; + SetLength(postmat,postrows,postcols); + if Cols3 > Rows3 then vectype := 3 else vectype := 2; + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid3.Cells[j+1,i+1]); + Op3Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + postcols := Cols4; + postrows := Rows4; + SetLength(postmat,postrows,postcols); + if Cols4 > Rows4 then vectype := 3 else vectype := 2; + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + postmat[i,j] := StrToFloat(Grid4.Cells[j+1,i+1]); + Op3Edit.Text := MatFourEdit.Text; + end; + end; + SetLength(prodmat,postrows,postcols); + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + prodmat[i,j] := premat[0,0]*postmat[i,j]; + case resultgrid of + 1 : begin + Grid1.RowCount := postrows+1; + Grid1.ColCount := postcols+1; + Rows1 := postrows; + Cols1 := postcols; + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + Grid1.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows1 do Grid1.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols1 do Grid1.Cells[i,0] := 'Col.' + IntToStr(i); + MatOneEdit.Text := 'Product'; + Op4Edit.Text := MatOneEdit.Text; + end; + 2 : begin + Grid2.RowCount := postrows+1; + Grid2.ColCount := postcols+1; + Rows2 := postrows; + Cols2 := postcols; + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + Grid2.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows2 do Grid2.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols2 do Grid2.Cells[i,0] := 'Col.' + IntToStr(i); + MatTwoEdit.Text := 'Product'; + Op4Edit.Text := MatTwoEdit.Text; + end; + 3 : begin + Grid3.RowCount := postrows+1; + Grid3.ColCount := postcols+1; + Rows3 := postrows; + Cols3 := postcols; + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + Grid3.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows3 do Grid3.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols3 do Grid3.Cells[i,0] := 'Col.' + IntToStr(i); + MatThreeEdit.Text := 'Product'; + Op4Edit.Text := MatThreeEdit.Text; + end; + 4 : begin + Grid4.RowCount := postrows+1; + Grid4.ColCount := postcols+1; + Rows4 := postrows; + Cols4 := postcols; + for i := 0 to postrows-1 do + for j := 0 to postcols-1 do + Grid4.Cells[j+1,i+1] := format('%10.5f',[prodmat[i,j]]); + for i := 1 to Rows4 do Grid4.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to Cols4 do Grid4.Cells[i,0] := 'Col.' + IntToStr(i); + MatFourEdit.Text := 'Product'; + Op4Edit.Text := MatFourEdit.Text; + end; + end; + Op1Edit.Text := 'ScalerxVector'; + if ScriptOp = false then + begin + Op2Edit.Text := ExtractFileName(Op2Edit.Text); + Op3Edit.Text := ExtractFileName(Op3Edit.Text); + Op4Edit.Text := ExtractFileName(Op4Edit.Text); + opstr := IntToStr(CurrentGrid) + '-'; + opstr := opstr + 'ScalerxVector:' + IntToStr(pregrid) + '-' + Op2Edit.Text; + opstr := opstr + ':' + IntToStr(postgrid) + '-' + Op3Edit.Text; + prmptstr := 'Save product as: '; + defaultstr := 'ScalerxVec'; + clickedok := InputQuery('SAVE AS',prmptstr,defaultstr); + if clickedok then info := defaultstr else info := 'ScalerxVec'; + if Length(info) > 0 then + begin + Op4Edit.Text := info; + end + else begin + Op4Edit.Text := 'ScalerxVec'; + info := 'ScalerxVec'; + end; + opstr := opstr + ':' + IntToStr(resultgrid) + '-' + Op4Edit.Text; + ScriptList.Items.Add(opstr); + CurrentObjName := info; + CurrentObjType := vectype; + CurrentGrid := resultgrid; + ComboAdd(CurrentObjName); + if clickedok then SaveFileMnuClick(Self); + case resultgrid of + 1 : MatOneEdit.Text := info; + 2 : MatTwoEdit.Text := info; + 3 : MatThreeEdit.Text := info; + 4 : MatFourEdit.Text := info; + end; + end; + // deallocate memory + prodmat := nil; + postmat := nil; + premat := nil; +end; + +procedure TMatManFrm.GetFile(Sender: TObject); +begin + OpenDialog1.Filter := 'Matrix (*.mat)|*.MAT|Col.Vector (*.CVE)|*.CVE|RowVector (*.RVE)|*.RVE|Scaler (*.scl)|*.SCA|All (*.*)|*.*'; + OpenDialog1.FilterIndex := CurrentObjType; + case CurrentObjType of + 1 : OpenDialog1.DefaultExt := '.MAT'; + 2 : OpenDialog1.DefaultExt := '.CVE'; + 3 : OpenDialog1.DefaultExt := '.RVE'; + 4 : OpenDialog1.DefaultExt := '.SCA'; + else OpenDialog1.DefaultExt := '.MAT'; + end; + GridNoEdit.Text := IntToStr(CurrentGrid); + GetGridData(CurrentGrid); +end; + +procedure TMatManFrm.GetGridData(gridno: integer); +var + SaveFile : TextFile; + i, j, iRows, iCols : integer; + cellstring : string; +// OpStr : string; + FName : string; + +begin + if OpenDialog1.Execute then + begin + AssignFile(SaveFile, OpenDialog1.FileName); + Reset(SaveFile); + Readln(SaveFile,CurrentObjType); + Readln(SaveFile,CurrentObjName); + CurrentObjName := ExtractFileName(CurrentObjName); + Readln(SaveFile,iRows); + Readln(SaveFile,iCols); + SetLength(Matrix1,iRows,iCols); + for i := 1 to iRows do + begin + for j := 1 to iCols do + begin + Readln(SaveFile,cellstring); + Matrix1[i-1,j-1] := StrToFloat(cellstring); + end; + end; + CloseFile(SaveFile); + end else exit; + + case gridno of + 1 : begin + MatOneEdit.Text := CurrentObjName; + Rows1 := iRows; + Cols1 := iCols; + Grid1.RowCount := iRows + 1; + Grid1.ColCount := iCols + 1; + for i := 1 to iCols do Grid1.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to iRows do Grid1.Cells[0,i] := 'Row' + IntToStr(i); + for i := 1 to iRows do + for j := 1 to iCols do + Grid1.Cells[j,i] := FloatToStr(Matrix1[i-1,j-1]); + end; + 2 : begin + MatTwoEdit.Text := CurrentObjName; + Rows2 := iRows; + Cols2 := iCols; + Grid2.RowCount := iRows + 1; + Grid2.ColCount := iCols + 1; + for i := 1 to iCols do Grid2.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to iRows do Grid2.Cells[0,i] := 'Row' + IntToStr(i); + for i := 1 to iRows do + for j := 1 to iCols do + Grid2.Cells[j,i] := FloatToStr(Matrix1[i-1,j-1]); + end; + 3 : begin + MatThreeEdit.Text := CurrentObjName; + Rows3 := iRows; + Cols3 := iCols; + Grid3.RowCount := iRows + 1; + Grid3.ColCount := iCols + 1; + for i := 1 to iCols do Grid3.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to iRows do Grid3.Cells[0,i] := 'Row' + IntToStr(i); + for i := 1 to iRows do + for j := 1 to iCols do + Grid3.Cells[j,i] := FloatToStr(Matrix1[i-1,j-1]); + end; + 4 : begin + MatFourEdit.Text := CurrentObjName; + Rows4 := iRows; + Cols4 := iCols; + Grid4.RowCount := iRows + 1; + Grid4.ColCount := iCols + 1; + for i := 1 to iCols do Grid4.Cells[i,0] := 'Col.'+ IntToStr(i); + for i := 1 to iRows do Grid4.Cells[0,i] := 'Row' + IntToStr(i); + for i := 1 to iRows do + for j := 1 to iCols do + Grid4.Cells[j,i] := FloatToStr(Matrix1[i-1,j-1]); + end; + end; + FName := ExtractFileName(CurrentObjName); + ComboAdd(FName); + + if ScriptOp = false then + begin + FName := IntToStr(CurrentGrid) + '-' + FName; + OpStr := IntToStr(CurrentGrid) + '-' + 'FileOpen:' + FName; + if ScriptOptsFrm.CheckGroup1.Checked[0] <> true then ScriptList.Items.Add(OpStr); + Op1Edit.Text := 'FileOpen'; + Op2Edit.Text := CurrentObjName; + Op3Edit.Text := ''; + Op4Edit.Text := ''; + end; + + Matrix1 := nil; +end; + +function TMatManFrm.sign(a, b: double): double; +begin + IF (b >= 0.0) THEN sign := abs(a) ELSE sign := -abs(a) +end; + +function TMatManFrm.max(a, b: double): double; +begin + IF (a > b) THEN max := a ELSE max := b +end; + +procedure TMatManFrm.matinv(a, vtimesw, v, w: DynMat; n: integer); +LABEL 1,2,3; + +VAR + ainverse : array of array of double; + m,mp,np,nm,l,k,j,its,i: integer; + z,y,x,scale,s,h,g,f,c,anorm: double; + rv1: array of double; + +begin + setlength(rv1,n); + setlength(ainverse,n,n); + m := n; + mp := n; + np := n; + g := 0.0; + scale := 0.0; + anorm := 0.0; + FOR i := 0 to n-1 DO BEGIN + l := i+1; + rv1[i] := scale*g; + g := 0.0; + s := 0.0; + scale := 0.0; + IF (i <= m-1) THEN BEGIN + FOR k := i to m-1 DO BEGIN + scale := scale+abs(a[k,i]) + END; + IF (scale <> 0.0) THEN BEGIN + FOR k := i to m-1 DO BEGIN + a[k,i] := a[k,i]/scale; + s := s+a[k,i]*a[k,i] + END; + f := a[i,i]; + g := -sign(sqrt(s),f); + h := f*g-s; + a[i,i] := f-g; + IF (i <> n-1) THEN BEGIN + FOR j := l to n-1 DO BEGIN + s := 0.0; + FOR k := i to m-1 DO BEGIN + s := s+a[k,i]*a[k,j] + END; + f := s/h; + FOR k := i to m-1 DO BEGIN + a[k,j] := a[k,j]+ + f*a[k,i] + END + END + END; + FOR k := i to m-1 DO BEGIN + a[k,i] := scale*a[k,i] + END + END + END; + w[i,i] := scale*g; + g := 0.0; + s := 0.0; + scale := 0.0; + IF ((i <= m-1) AND (i <> n-1)) THEN BEGIN + FOR k := l to n-1 DO BEGIN + scale := scale+abs(a[i,k]) + END; + IF (scale <> 0.0) THEN BEGIN + FOR k := l to n-1 DO BEGIN + a[i,k] := a[i,k]/scale; + s := s+a[i,k]*a[i,k] + END; + f := a[i,l]; + g := -sign(sqrt(s),f); + h := f*g-s; + a[i,l] := f-g; + FOR k := l to n-1 DO BEGIN + rv1[k] := a[i,k]/h + END; + IF (i <> m-1) THEN BEGIN + FOR j := l to m-1 DO BEGIN + s := 0.0; + FOR k := l to n-1 DO BEGIN + s := s+a[j,k]*a[i,k] + END; + FOR k := l to n-1 DO BEGIN + a[j,k] := a[j,k] + +s*rv1[k] + END + END + END; + FOR k := l to n-1 DO BEGIN + a[i,k] := scale*a[i,k] + END + END + END; + anorm := max(anorm,(abs(w[i,i])+abs(rv1[i]))) + END; + FOR i := n-1 DOWNTO 0 DO BEGIN + IF (i < n-1) THEN BEGIN + IF (g <> 0.0) THEN BEGIN + FOR j := l to n-1 DO BEGIN + v[j,i] := (a[i,j]/a[i,l])/g + END; + FOR j := l to n-1 DO BEGIN + s := 0.0; + FOR k := l to n-1 DO BEGIN + s := s+a[i,k]*v[k,j] + END; + FOR k := l to n-1 DO BEGIN + v[k,j] := v[k,j]+s*v[k,i] + END + END + END; + FOR j := l to n-1 DO BEGIN + v[i,j] := 0.0; + v[j,i] := 0.0 + END + END; + v[i,i] := 1.0; + g := rv1[i]; + l := i + END; + FOR i := n-1 DOWNTO 0 DO BEGIN + l := i+1; + g := w[i,i]; + IF (i < n-1) THEN BEGIN + FOR j := l to n-1 DO BEGIN + a[i,j] := 0.0 + END + END; + IF (g <> 0.0) THEN BEGIN + g := 1.0/g; + IF (i <> n-1) THEN BEGIN + FOR j := l to n-1 DO BEGIN + s := 0.0; + FOR k := l to m-1 DO BEGIN + s := s+a[k,i]*a[k,j] + END; + f := (s/a[i,i])*g; + FOR k := i to m-1 DO BEGIN + a[k,j] := a[k,j]+f*a[k,i] + END + END + END; + FOR j := i to m-1 DO BEGIN + a[j,i] := a[j,i]*g + END + END ELSE BEGIN + FOR j := i to m-1 DO BEGIN + a[j,i] := 0.0 + END + END; + a[i,i] := a[i,i]+1.0 + END; + FOR k := n-1 DOWNTO 0 DO BEGIN + FOR its := 1 to 30 DO BEGIN + FOR l := k DOWNTO 0 DO BEGIN + nm := l-1; + IF ((abs(rv1[l])+anorm) = anorm) THEN GOTO 2; + IF ((abs(w[nm,nm])+anorm) = anorm) THEN GOTO 1 + END; +1: c := 0.0; + s := 1.0; + FOR i := l to k DO BEGIN + f := s*rv1[i]; + IF ((abs(f)+anorm) <> anorm) THEN BEGIN + g := w[i,i]; + h := sqrt(f*f+g*g); + w[i,i] := h; + h := 1.0/h; + c := (g*h); + s := -(f*h); + FOR j := 0 to m-1 DO BEGIN + y := a[j,nm]; + z := a[j,i]; + a[j,nm] := (y*c)+(z*s); + a[j,i] := -(y*s)+(z*c) + END + END + END; +2: z := w[k,k]; + IF (l = k) THEN BEGIN + IF (z < 0.0) THEN BEGIN + w[k,k] := -z; + FOR j := 0 to n-1 DO BEGIN + v[j,k] := -v[j,k] + END + END; + GOTO 3 + END; + IF (its = 30) THEN BEGIN + showmessage('No convergence in 30 SVDCMP iterations'); + exit; + END; + x := w[l,l]; + nm := k-1; + y := w[nm,nm]; + g := rv1[nm]; + h := rv1[k]; + f := ((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y); + g := sqrt(f*f+1.0); + f := ((x-z)*(x+z)+h*((y/(f+sign(g,f)))-h))/x; + c := 1.0; + s := 1.0; + FOR j := l to nm DO BEGIN + i := j+1; + g := rv1[i]; + y := w[i,i]; + h := s*g; + g := c*g; + z := sqrt(f*f+h*h); + rv1[j] := z; + c := f/z; + s := h/z; + f := (x*c)+(g*s); + g := -(x*s)+(g*c); + h := y*s; + y := y*c; + FOR nm := 0 to n-1 DO BEGIN + x := v[nm,j]; + z := v[nm,i]; + v[nm,j] := (x*c)+(z*s); + v[nm,i] := -(x*s)+(z*c) + END; + z := sqrt(f*f+h*h); + w[j,j] := z; + IF (z <> 0.0) THEN BEGIN + z := 1.0/z; + c := f*z; + s := h*z + END; + f := (c*g)+(s*y); + x := -(s*g)+(c*y); + FOR nm := 0 to m-1 DO BEGIN + y := a[nm,j]; + z := a[nm,i]; + a[nm,j] := (y*c)+(z*s); + a[nm,i] := -(y*s)+(z*c) + END + END; + rv1[l] := 0.0; + rv1[k] := f; + w[k,k] := x + END; +3: END; +{ mat_print(m,a,'U matrix'); + mat_print(n,v,'V matrix'); + writeln(lst,'Diagonal values of W inverse matrix'); + for i := 1 to n do + write(lst,1/w[i]:6:3); + writeln(lst); } + for i := 0 to n-1 do + for j := 0 to n-1 do + begin + if w[i,i] < 1.0e-6 then vtimesw[i,j] := 0 + else vtimesw[i,j] := v[i,j] * (1.0 / w[j,j] ); + end; +{ mat_print(n,vtimesw,'V matrix times w inverse '); } + for i := 0 to m-1 do + for j := 0 to n-1 do + begin + ainverse[i,j] := 0.0; + for k := 0 to m-1 do + begin + ainverse[i,j] := ainverse[i,j] + vtimesw[i,k] * a[j,k] + end; + end; +{ mat_print(n,ainverse,'Inverse Matrix'); } + for i := 0 to n-1 do + for j := 0 to n-1 do + a[i,j] := ainverse[i,j]; + ainverse := nil; + rv1 := nil; +end; + +procedure TMatManFrm.ResetGrids(Sender: TObject); +var + i, j : integer; + +begin + rows1 := 4; + cols1 := 4; + Grid1.RowCount := 5; + Grid1.ColCount := 5; + for i := 0 to Rows1 do + for j := 0 to Cols1 do + Grid1.Cells[j,i] := ''; + Grid1.Cells[0,0] := 'Row/Col'; + for i := 1 to rows1 do Grid1.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to cols1 do Grid1.Cells[i,0] := 'Col ' + IntToStr(i); + + rows2 := 4; + cols2 := 4; + Grid2.RowCount := 5; + Grid2.ColCount := 5; + for i := 0 to Rows2 do + for j := 0 to Cols2 do + Grid2.Cells[j,i] := ''; + Grid2.Cells[0,0] := 'Row/Col'; + for i := 1 to rows2 do Grid2.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to cols2 do Grid2.Cells[i,0] := 'Col ' + IntToStr(i); + + rows3 := 4; + cols3 := 4; + Grid3.RowCount := 5; + Grid3.ColCount := 5; + for i := 0 to Rows3 do + for j := 0 to Cols3 do + Grid3.Cells[j,i] := ''; + Grid3.Cells[0,0] := 'Row/Col'; + for i := 1 to rows3 do Grid3.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to cols3 do Grid3.Cells[i,0] := 'Col ' + IntToStr(i); + + rows4 := 4; + cols4 := 4; + Grid4.RowCount := 5; + Grid4.ColCount := 5; + for i := 0 to Rows4 do + for j := 0 to Cols4 do + Grid4.Cells[j,i] := ''; + Grid4.Cells[0,0] := 'Row/Col'; + for i := 1 to rows4 do Grid4.Cells[0,i] := 'Row ' + IntToStr(i); + for i := 1 to cols4 do Grid4.Cells[i,0] := 'Col ' + IntToStr(i); + +// ScriptList.Clear; + CurrentObjName := ''; + CurrentObjType := 0; + CurrentGrid := 1; + CurrentObjType := 1; + Op4Edit.Text := ''; + Op1Edit.Text := ''; + Op2Edit.Text := ''; + Op3Edit.Text := ''; + MatOneEdit.Text := ''; + MatTwoEdit.Text := ''; + MatThreeEdit.Text := ''; + MatFourEdit.Text := ''; + MatCount := 0; + ColVecCount := 0; + RowVecCount := 0; + ScaCount := 0; + Saved := true; + ScriptOp := false; + LastScript := 0; + LastGridNo := 1; + GridNoEdit.Text := '1'; + MatricesBox.Clear; + MatricesBox.Text := 'Matrices'; + ColVecsBox.Clear; + ColVecsBox.Text := 'Col.Vectors'; + RowVecsBox.Clear; + RowVecsBox.Text := 'RowVectors'; + ScalarsBox.Clear; + ScalarsBox.Text := 'Scalers'; +// PrntForm.RichEdit.Clear; +end; + +function TMatManFrm.DuplicateMat(str: string): boolean; +var + itemcnt : integer; + i : integer; + rslt : boolean; + +begin + rslt := false; + itemcnt := MatricesBox.Items.Count; + if itemcnt > 0 then + begin + for i := 0 to itemcnt - 1 do + if MatricesBox.Items.Strings[i] = str then rslt := true; + end; + Result := rslt; +end; + +function TMatManFrm.DuplicateColVec(str: string): boolean; +var + itemcnt : integer; + i : integer; + rslt : boolean; + +begin + rslt := false; + itemcnt := ColVecsbox.Items.Count; + if itemcnt > 0 then + begin + for i := 0 to itemcnt - 1 do + if ColVecsBox.Items.Strings[i] = str then rslt := true; + end; + Result := rslt; +end; + +function TMatManFrm.DuplicateRowVec(str: string): boolean; +var + itemcnt : integer; + i : integer; + rslt : boolean; + +begin + rslt := false; + itemcnt := RowVecsBox.Items.Count; + if itemcnt > 0 then + begin + for i := 0 to itemcnt - 1 do + if RowVecsBox.Items.Strings[i] = str then rslt := true; + end; + Result := rslt; +end; + +function TMatManFrm.DuplicateScaler(str: string): boolean; +var + itemcnt : integer; + i : integer; + rslt : boolean; + +begin + rslt := false; + itemcnt := scalarsBox.Items.Count; + if itemcnt > 0 then + begin + for i := 0 to itemcnt - 1 do + if ScalarsBox.Items.Strings[i] = str then rslt := true; + end; + Result := rslt; +end; + +procedure TMatManFrm.tred2(var a: DynMat; n: integer; var d, e: DynVec); +VAR + L,k,j,i: integer; + scale,hh,h,g,f: double; + +begin + IF (n > 1) THEN + BEGIN + FOR i := n-1 DOWNTO 1 DO + BEGIN + L := i-1; + h := 0.0; + scale := 0.0; + IF (L > 0) THEN + BEGIN + FOR k := 0 to L DO scale := scale+abs(a[i,k]); + IF (scale = 0.0) THEN e[i] := a[i,L] + ELSE BEGIN + FOR k := 0 to L DO + BEGIN + a[i,k] := a[i,k]/scale; + h := h+sqr(a[i,k]) + END; + f := a[i,L]; + g := -sign(sqrt(h),f); + e[i] := scale*g; + h := h-f*g; + a[i,L] := f-g; + f := 0.0; + FOR j := 0 to L DO + BEGIN + (* Next statement can be omitted if eigenvectors not wanted *) + a[j,i] := a[i,j]/h; + g := 0.0; + FOR k := 0 to j DO g := g+a[j,k]*a[i,k]; + IF (L > j) THEN FOR k := j+1 to L DO g := g+a[k,j]*a[i,k]; + e[j] := g/h; + f := f+e[j]*a[i,j] + END; + hh := f/(h+h); + FOR j := 0 to L DO + BEGIN + f := a[i,j]; + g := e[j]-hh*f; + e[j] := g; + FOR k := 0 to j DO a[j,k] := a[j,k]-(f*e[k]+g*a[i,k]); + END; + END; + END ELSE e[i] := a[i,L]; + d[i] := h; + END; + END; + (* Next statement can be omitted if eigenvectors not wanted *) + d[0] := 0.0; + e[0] := 0.0; + FOR i := 0 to n-1 DO + BEGIN + (* Contents of this loop can be omitted if eigenvectors not wanted, + except for statement d[i] := a[i,i]; *) + L := i-1; + IF (d[i] <> 0.0) THEN + BEGIN + FOR j := 0 to L DO + BEGIN + g := 0.0; + FOR k := 0 to L DO g := g+a[i,k]*a[k,j]; + FOR k := 0 to L DO a[k,j] := a[k,j]-g*a[k,i]; + END; + END; + d[i] := a[i,i]; + a[i,i] := 1.0; + IF (L >= 0) THEN + BEGIN + FOR j := 0 to L DO BEGIN + a[i,j] := 0.0; + a[j,i] := 0.0; + END; + END; + END; +end; + +procedure TMatManFrm.ludcmp(var a: DynMat; n: integer; var indx: DynIntVec; + var d: double); +CONST tiny=1.0e-20; + +VAR k,j,imax,i: integer; + sum,dum,big: double; + vv: DynVec; + +begin + SetLength(vv,n); + d := 1.0; + FOR i := 0 to n-1 DO BEGIN + big := 0.0; + FOR j := 0 to n-1 DO IF (abs(a[i,j]) > big) THEN big := abs(a[i,j]); + IF (big = 0.0) THEN BEGIN + ShowMessage('Error - Singular matrix!'); + vv := nil; + exit; + END; + vv[i] := 1.0/big; + END; + FOR j := 0 to n-1 DO BEGIN + IF (j > 0) THEN BEGIN + FOR i := 0 to j-1 DO BEGIN + sum := a[i,j]; + IF (i > 0) THEN BEGIN + FOR k := 0 to i-1 DO sum := sum-a[i,k]*a[k,j]; + a[i,j] := sum; + END; + END; + END; + big := 0.0; + FOR i := j to n-1 DO BEGIN + sum := a[i,j]; + IF (j > 0) THEN BEGIN + FOR k := 0 to j-1 DO sum := sum-a[i,k]*a[k,j]; + a[i,j] := sum; + END; + dum := vv[i]*abs(sum); + IF (dum >= big) THEN BEGIN + big := dum; + imax := i; + END; + END; + IF (j <> imax) THEN BEGIN + FOR k := 0 to n-1 DO BEGIN + dum := a[imax,k]; + a[imax,k] := a[j,k]; + a[j,k] := dum; + END; + d := -d; + vv[imax] := vv[j]; + END; + indx[j] := imax; + IF (a[j,j] = 0.0) THEN a[j,j] := tiny; + IF (j <> n-1) THEN BEGIN + dum := 1.0/a[j,j]; + FOR i := j+1 to n-1 DO a[i,j] := a[i,j]*dum; + END + END; + IF (a[n-1,n-1] = 0.0) THEN a[n-1,n-1] := tiny; + vv := nil; +end; + +procedure TMatManFrm.DynMatPrint(var xmat: DynMat; rows, cols: integer; + var title: string; var ColHeadings: Dynstrarray); +var + i, j, first, last, nflds : integer; + done : boolean; + outline: string; + valstring: string; + +begin + OutputFrm.RichEdit.Lines.Add(title); + OutputFrm.RichEdit.Lines.Add(''); + nflds := 4; + done := FALSE; + first := 0; + while not done do + begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add(' Columns'); + outline := ' '; + last := first + nflds; + if last >= cols - 1 then + begin + done := TRUE; + last := cols - 1 + end; + for i := first to last do + begin + outline := outline + format('%12s ',[ColHeadings[i]]); + end; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add('Rows'); + for i := 0 to rows-1 do + begin + outline := format('%5d ',[i+1]); + for j := first to last do + begin + valstring := format('%12.3f ',[xmat[i,j]]); + outline := outline + valstring; + end; + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + first := last + 1 + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add(''); +end; + +procedure TMatManFrm.ComboAdd(FileName: String); +var + rslt : boolean; + +begin + if CurrentObjType = 1 then // matrix + begin + rslt := DuplicateMat(FileName); + if rslt = false then + begin + MatricesBox.Items.Add(FileName); + MatCount := MatCount + 1; + end; + end; + + if (CurrentObjType = 2) then // column vector + begin + rslt := DuplicateColVec(FileName); + if rslt = false then + begin + ColVecsBox.Items.Add(FileName); + ColVecCount := ColVecCount + 1; + end; + end; + + if CurrentObjType = 3 then // row vector + begin + rslt := DuplicateRowVec(FileName); + if rslt = false then + begin + RowVecsBox.Items.Add(FileName); + RowVecCount := RowVecCount + 1; + end; + end; + + if CurrentObjType = 4 then // scaler + begin + rslt := DuplicateScaler(FileName); + if rslt = false then + begin + ScalarsBox.Items.Add(FileName); + ScaCount := ScaCount + 1; + end; + end; +end; + +procedure TMatManFrm.tqli(var d: DynVec; var e: DynVec; n: integer; + var z: DynMat); +LABEL 1,2; +VAR + m,L,iter,i,k: integer; + s,r,p,g,f,dd,c,b: double; + +begin + IF (n > 1) THEN + BEGIN + FOR i := 1 to n-1 DO e[i-1] := e[i]; + e[n-1] := 0.0; + FOR L := 0 to n-1 DO + BEGIN + iter := 0; +1: FOR m := L to n-2 DO + BEGIN + dd := abs(d[m])+abs(d[m+1]); + IF ((abs(e[m])+ dd) = dd) THEN GOTO 2 + END; + m := n-1; +2: IF (m <> L) THEN + BEGIN + IF (iter = 30) THEN + BEGIN + showmessage('Too many iterations in routine tqli-returning'); + exit; + END; + iter := iter+1; + g := (d[L+1]-d[L])/(2.0*e[L]); + r := sqrt(sqr(g)+1.0); + g := d[m]-d[L]+e[L]/(g+sign(r,g)); + s := 1.0; + c := 1.0; + p := 0.0; + FOR i := m-1 DOWNTO L DO + BEGIN + f := s*e[i]; + b := c*e[i]; + IF (abs(f) >= abs(g)) THEN + BEGIN + c := g/f; + r := sqrt(sqr(c)+1.0); + e[i+1] := f*r; + s := 1.0/r; + c := c*s + END + ELSE BEGIN + s := f/g; + r := sqrt(sqr(s)+1.0); + e[i+1] := g*r; + c := 1.0/r; + s := s*c + END; + g := d[i+1]-p; + r := (d[i]-g)*s+2.0*c*b; + p := s*r; + d[i+1] := g+p; + g := c*r-b; + (* Next loop can be omitted if eigenvectors not wanted *) + FOR k := 0 to n-1 DO + BEGIN + f := z[k,i+1]; + z[k,i+1] := s*z[k,i]+c*f; + z[k,i] := c*z[k,i]-s*f + END + END; + d[L] := d[L]-p; + e[L] := g; + e[m] := 0.0; + GOTO 1 + END; + END; + END; +end; + +procedure TMatManFrm.xtqli(var a: DynMat; NP: integer; var d: DynVec; + var f: DynVec; var e: DynVec); +var + i : integer; + sum : double; + +begin + sum := 0.0; + tred2(a, NP, d, e); + tqli(d, e, NP, a); + for i := 0 to NP-1 do + begin + f[i] := 0.0; + sum := sum + d[i]; + end; + for i := 0 to NP-1 do f[i] := (d[i] / sum) * 100.0; +end; + +function TMatManFrm.SEVS(nv, nf: integer; C: double; var r: DynMat; + var v: DynMat; var e: DynVec; var p: DynVec; nd: integer): integer; +Label Label12, Label13; +var + i, j, k, M : integer; + t, ee, ev, sum : double; + +begin + // extracts roots and denormal vectors from a symetric matrix. + // Veldman, 1967, page 209 + + t := 0.0; + for i := 0 to nv-1 do t := t + r[i,i]; + for k := 0 to nf-1 do // roots in e(k) and vector in v(.k) + begin + for i := 0 to nv-1 do p[i] := 1.0; + e[k] := 1.0; + for M := 0 to 99 do + begin + for i := 0 to nv-1 do v[i,k] := p[i] / e[k]; + for i := 0 to nv-1 do + begin + sum := 0.0; + for j := 0 to nv-1 do + begin + sum := sum + (r[i,j] * v[j,k]); + end; + p[i] := sum; + end; + ee := 0.0; + for j := 0 to nv-1 do ee := ee + p[j] * v[j,k]; + e[k] := sqrt(abs(ee)); + end; + if (ee < (C * C)) then goto label12; + for i := 0 to nv-1 do + begin + for j := 0 to nv - 1 do r[i,j] := r[i,j] - (v[i,k] * v[j,k]); + end; + end; + goto label13; +label12: + nf := k - 1; +label13: + for i := 0 to nf-1 do p[i] := e[i] / t * 100.0; + ev := 0.0; + for i := 0 to nf-1 do ev := ev + p[i]; + //outform.list1.AddItem "Trace := " & fmtstring(t, 6, 3) & " " & + //fmtstring(ev, 6, 3) & " Pct. of trace extracted by " & fmtstring + //(nf, 3, 0) & " roots." + //lineno := lineno + 1 + result := nf; +end; + +procedure TMatManFrm.nonsymroots(var a: DynMat; nv: integer; var nf: integer; + c: double; var v: DynMat; var e: DynVec; var x: DynVec; var t: double; + var ev: double); +Label endit; +var + y, z : DynVec; + ek, e2, d : double; + i, j, k, m : integer; + +begin + // roots and vectors of a non symetric matrix. a is square matrix + // entered and is destroyed in process. nv is number of variables + // (rows and columns )of a. nf is the number of factors to be + // extracted - is output as the number which exceeded c, the + // minimum eigenvalue to be extracted. v is the output matrix of + // column vectors of loadings. e is the output vector of roots. x + // is the percentages of trace for factors. t is the trace of the + // matrix and ev is the percent of trace extracted. + + e2 := 0.0; + setlength(y,nv); + setlength(z,nv); + t := 0.0; + for i := 0 to nv-1 do t := t + a[i,i]; + for k := 0 to nf-1 do + begin + for i := 0 to nv-1 do + begin + x[i] := 1.0; + y[i] := 1.0; + end; + e[k] := 1.0; + ek := 1.0; + for m := 0 to 99 do + begin + for i := 0 to nv-1 do + begin + v[i,k] := x[i] / e[k]; + z[i] := y[i] / ek; + end; + for i := 0 to nv-1 do + begin + x[i] := 0.0; + for j := 0 to nv-1 do x[i] := x[i] + a[i,j] * v[j,k]; + y[i] := 0.0; + for j := 0 to nv-1 do y[i] := y[i] + a[j,i] * z[j]; + end; + e2 := 0.0; + for j := 0 to nv-1 do e2 := e2 + x[j] * v[j,k]; + e[k] := sqrt(abs(e2)); + ek := 0.0; + for j := 0 to nv-1 do ek := ek + y[j] * z[j]; + ek := sqrt(abs(ek)); + end; + if (e2 >= (c * c)) then + begin + d := 0.0; + for j := 0 to nv-1 do d := d + v[j,k] * z[j]; + d := e[k] / d; + for i := 0 to nv-1 do + for j := 0 to nv-1 do + a[i,j] := a[i,j] - v[i,k] * z[j] * d; + end + else + begin + nf := k - 1; + goto endit; + end; + end; +endit: + for i := 0 to nf-1 do x[i] := e[i] / t * 100.0; + ev := 0.0; + for i := 0 to nf-1 do ev := ev + x[i]; + z := nil; + y := nil; +end; + +procedure TMatManFrm.OPRINC(S: DynVec; M, IA: integer; var EVAL: DynVec; + var EVEC: DynMat; var COMP: DynMat; var VARPCNT: DynVec; var CL: DynVec; + var CU: DynVec; var IER: integer); +var + i, j, k : integer; + zero, one, rnine, hund, scale, an, sum, sumr, anp, anm : double; + +begin + // Adapted from the IMSL routine OPRINC. S contains the lower half + // of a covariance or correlation matrix (including the diagonal + // values.) It returns eigenvalues in the EVAL vector, eigenvectors + // in the matrix EVEC from the analysis of S. The order of the + // matrix is M and IA roots roots are extracted. Comp is a + // returned M by M component correlation matrix. VARPCNT of length M + // contains percentages of total variance associated with the + // components, in the order of the eigenvalues. On entry, CL is + // the number of subjects on which S is based. On return it + // contains the left 95% confidence bounds on the eigenvalues. CU + // returns the right 95% confidence bounds on the eigenvalues. IER + // is the error flag returned and is zero if there is no error. + // NOTE!! Counting starts at 1, not 0! + + zero := 0.0; + one := 1.0; + rnine := 9.0; + hund := 100.0; + scale := 2.7718585822513; + IER := 0; + an := CL[1]; + for i := 1 to M do + begin + for j := 1 to M do EVEC[i,j] := 0.0; + EVEC[i,i] := 1.0; + end; + k := 0; + for i := 1 to M do + begin + k := k + i; + CL[i] := sqrt(S[k]); + end; + EHOUSS(S, M, EVAL, VARPCNT, CU); + EQRT2S(EVAL, VARPCNT, M, EVEC, IA, IER); + if (IER <> 0) then + begin + UERTST(IER,'OPRINC'); + exit; + end; + EHOBKS(S, M, 1, M, EVEC, IA); + sum := zero; + for i := 1 to M do + begin + if (EVAL[i] < zero) then EVAL[i] := 0; + sum := sum + EVAL[i]; + end; + sumr := hund / sum; + for i := 1 to M do VARPCNT[i] := EVAL[i] * sumr; + // compute COMP (correlations) matrix + for i := 1 to M do + begin + sumr := one / CL[i]; + for j := 1 to M do COMP[i,j] := sqrt(EVAL[j]) * EVEC[i,j] * sumr; + end; + if (an < rnine) then + begin + an := rnine; + IER := 34; + end; + an := sqrt(an-one); + // Compute vector CL + anp := an / (an + scale); + anm := an / (an - scale); + for i := 1 to M do + begin + CL[i] := EVAL[i] * anp; + CU[i] := EVAL[i] * anm; + end; + if (IER <> 0) then UERTST(IER,'OPRINC'); +end; + +procedure TMatManFrm.EHOUSS(var A: DynVec; N: integer; var D: DynVec; + var E: DynVec; var E2: DynVec); +Label fifteen, sixtyfive; +var + zero, h, scale, f, g, hh : double; + np1, nn, nbeg, ii, i, j, L, nk, k, jk1, ik, jk, jp1 : integer; + +begin + //Called by OPRINC for obtaining eigenvalues and vectors + // Adapted from the IMSL routine by the same name + //NOTE! Subscripts start at 1, not 0! + + zero := 0.0; + np1 := N + 1; + nn := (N * np1) div 2 - 1; + nbeg := nn + 1 - N; + for ii := 1 to N do // major loop + begin + i := np1 - ii; + L := i - 1; + h := zero; + scale := zero; + if (L >= 1) then + begin + nk := nn; + for k := 1 to L do + begin + scale := scale + abs(A[nk]); + nk := nk - 1; + end; + if (scale <> 0.0) then goto fifteen; + end; + E[i] := zero; + E2[i] := zero; + goto sixtyfive; +fifteen: nk := nn; + for k := 1 to L do + begin + A[nk] := A[nk] / scale; + h := h + (A[nk] * A[nk]); + nk := nk - 1; + end; + E2[i] := scale * scale * h; + f := A[nn]; + g := -DSIGN(sqrt(h),f); + E[i] := scale * g; + h := h - (f * g); + A[nn] := f - g; + if (L <> 1) then + begin + f := zero; + jk1 := 1; + for j := 1 to L do + begin + g := zero; + ik := nbeg + 1; + jk := jk1; + // form element of A * U + for k := 1 to j do + begin + g := g + (A[jk] * A[ik]); + jk := jk + 1; + ik := ik + 1; + end; + jp1 := j + 1; + if (L >= jp1) then + begin + jk := jk + (j - 1); + for k := jp1 to L do + begin + g := g + (A[jk] * A[ik]); + jk := jk + k; + ik := ik + 1; + end; + end; + E[j] := g / h; + f := f + (E[j] * A[nbeg + j]); + jk1 := jk1 + j; + end; // 40 + hh := f / (h + h); + // form reduced A + jk := 1; + for j := 1 to L do + begin + f := A[nbeg + j]; + g := E[j] - hh * f; + E[j] := g; + for k := 1 to j do + begin + A[jk] := A[jk] - (f * E[k]) - (g * A[nbeg + k]); + jk := jk + 1; + end; + end; + end; // end if L <> 1 + for k := 1 to L do A[nbeg+k] := A[nbeg+k] * scale; +sixtyfive: D[i] := A[nbeg+i]; + A[nbeg+i] := h * scale * scale; + nbeg := nbeg - i + 1; + nn := nn - i; + end; // 70 +end; + +function TMatManFrm.DSIGN(X, Y: double): double; +begin + if (Y < 0.0) then result := -abs(X) + else result := abs(X); +end; + +function TMatManFrm.isign(a, b: integer): integer; +begin + IF (b >= 0) then isign := abs(a) ELSE isign := -abs(a) +end; + +procedure TMatManFrm.EQRT2S(var D: DynVec; var E: DynVec; N: integer; + var Z: DynMat; var IZ: integer; var IER: integer); +Label twenty, fiftyfive, fifty, thirtyfive; +var + B, C, F, G, H, P, R, S, RDELP, ONE, ZERO : double; + i1, I, II, J, K, L, L1, M, MM1, MM1PL, IP1 : integer; + +begin + // Adapted from the IMSL routine by the same name + // NOTE! Subscripts start at 1, not 0! + // On input, the vector D of length N contains the diagonal + // elements of the symmetric tridiagonal matrix T. On output, D + // contains the eigenvalues of T in ascending order. On input, the + // vector e of length N contains the sub-diagonal elements of T in + // position 2,...,N. On output, E is destroyed. N -order of + // tridiagonal matrix T. (input) Z -On input, z contains the + // identity matrix of order N. On output, Z contains the + // eigenvector in column J of Z corresponding to the eigenvalue + // D[j]. + // -Input row dimension of matrix Z exactly as specified in the + // calling program. If IZ is less than N, the eigenvectors are not + // computed. In this case, Z is not used. + // IER - Error parameter. + + RDELP := 0.222045E-15; + ONE := 1.0; + ZERO := 0.0; + + // Move the last N-1 elements of E into the first N-1 locations + IER := 0; + if (N = 1) then exit; + for i1 := 2 to N do E[i1-1] := E[i1]; + E[N] := ZERO; + B := ZERO; + F := ZERO; + for L := 1 to N do + begin + J := 0; + H := RDELP * (abs(D[L]) + abs(E[L])); + if (B < H) then B := H; + // Look for small sub-diagonal element + for M := 1 to N do + begin + K := M; + if (abs(E[K]) <= B) then continue; + end; + M := K; + if (M = L) then goto fiftyfive; +twenty: if (J = 30) then + begin + IER := 128 + L; + UERTST(IER,'EQR2S'); + exit; + end; + J := J + 1; + L1 := L + 1; + G := D[L]; + P := (D[L1] - G) / (E[L] + E[L]); + R := abs(P); + if (RDELP * abs(P) < 1.0) then R := sqrt(P * P + ONE); + D[L] := E[L] / (P + DSIGN(R,P)); + H := G - D[L]; + for I := L1 to N do D[I] := D[I] - H; + F := F + H; + // QL Transformation + P := D[M]; + C := ONE; + S := ZERO; + MM1 := M - 1; + MM1PL := MM1 + L; + if (L > MM1) then goto fifty; + for II := L to MM1 do + begin + I := MM1PL - II; + G := C * E[I]; + H := C * P; + if (abs(P) >= abs(E[I])) then + begin + C := E[I] / P; + R := sqrt(C * C + ONE); + E[I + 1] := S * P * R; + S := C / R; + C := ONE / R; + goto thirtyfive; + end; + C := P / E[I]; + R := sqrt(C * C + ONE); + E[I + 1] := S * E[I] * R; + S := ONE / R; + C := C * S; +thirtyfive: P := C * D[I] - S * G; + D[I + 1] := H + S * (C * G + S * D[I]); + if (IZ >= N) then + begin + // Form vector + for K := 1 to N do + begin + H := Z[K,I+1]; + Z[K,I+1] := S * Z[K,I] + C * H; + Z[K,I] := C * Z[K,I] - S * H; + end; + end; + end; // next II +fifty: E[L] := S * P; + D[L] := C * P; + if (abs(E[L]) > B) then goto twenty; +fiftyfive: D[L] := D[L] + F; + end; // next L + // Order Eigenvalues and Eigenvectors + for I := 1 to N do + begin + K := I; + P := D[I]; + IP1 := I + 1; + if (IP1 <= N) then + begin + for J := IP1 to N do + begin + if (D[J] >= P) then continue; + K := J; + P := D[J]; + end; + end; + if (K = I) then exit; + D[K] := D[I]; + D[I] := P; + if (IZ < N) then exit; + for J := 1 to N do + begin + P := Z[J,I]; + Z[J,I] := Z[J,K]; + Z[J,K] := P; + end; + end; // next I +end; + +procedure TMatManFrm.EHOBKS(var A: DynVec; N, M1, M2: integer; var Z: DynMat; + IZ: integer); +var + H, S : double; + I, L, J, K, IA : integer; + +begin + // IMSL routine by the same name + if (N = 1) then exit; + for I := 2 to N do + begin + L := I - 1; + IA := (I * L) div 2; + H := A[IA+I]; + if (H = 0.0) then exit; + // Derives eigenvectors M1 to M2 of the original matrix from + // M1 to M2 of the symmetric tridiagonal matrix + for J := M1 to M2 do + begin + S := 0.0; + for K := 1 to L do S := S + (A[IA+K] * Z[K,J]); + S := S / H; + for K := 1 to L do Z[K,J] := Z[K,J] - (S * A[IA+K]); + end; + end; +end; + +procedure TMatManFrm.UERTST(IER: integer; aNAME: string); +var + IEQDF, LEVEL: integer; + IEQ, NAMSET, NAMUPK, NAMEQ, ASTRING : string; + +begin + // Substitute for the IMSL routine by the same name + // IER is input error parameter where IER := I + J where + // I := 128 implies terminal error message, + // I := 64 implies warning with fix message, + // I := 32 implies warning message, + // J := error code relevant to calling routine. + // NAME is a character string providing the name of the calling + // routine output is displayed as an application message box + + IEQDF := 0; + LEVEL := 4; + IEQ := '='; + NAMSET := 'UERSET'; + NAMEQ := ' '; + + NAMUPK := NAME; + if (IER <= 999) then + begin + if (LEVEL < 4) then + begin + IEQDF := 0; + exit; + end; + end; + if (IER < -32) then + begin + IEQDF := 1; + NAMEQ := NAMUPK; + exit; + end; + if (IER < 128) then + begin + + end; + + astring := 'Routine '; + astring := astring + NAME; + astring := astring + ' called UERTST with the error code = '; + astring := astring + IntToStr(IER); + ShowMessage(astring); +end; + +procedure TMatManFrm.Roots(var RMat: DynMat; NITEMS: integer; + var EIGENVAL: DynVec; var EIGENVEC: DynMat); +var + i, j, L, IER, size, size2, NSUBS : integer; + EVAL : DynVec; + DCORR : DynVec; + PERVAR : DynVec; + ICL : DynVec; + CU : DynVec; + COMP : DynMat; + EVEC : DynMat; + response : string; + +begin + size := ((NITEMS * (NITEMS - 1)) div 2) + NITEMS + 1; + size2 := (NITEMS + 1) * (NITEMS + 1); + setlength(DCORR,size); + setlength(EVAL,size); + setlength(PERVAR,size); + setlength(ICL,size); + setlength(CU,size); + setlength(COMP,size2,size2); + setlength(EVEC,size2,size2); + // Move values up one subscript in array since the roots routine + // counts from 1, not zero. Store only lower half matrix + L := 1; + response := inputbox('Sample Size','No. of cases :','1000'); + NSUBS := StrToInt(response); // number of cases + for i := 0 to NITEMS-1 do + begin + for j := 0 to i do + begin + DCORR[L] := RMat[i,j]; + L := L + 1; + end; + end; + DCORR[0] := 0.0; + + // Get the iegenvalues and vectors of the correlation matrix. + // EVAL holds the values and EVEC holds the vectors + ICL[1] := NSUBS; + OPRINC(DCORR,NITEMS,NITEMS,EVAL,EVEC,COMP,PERVAR,ICL,CU,IER); + for i := 1 to NITEMS do + begin + EIGENVAL[i-1] := EVAL[i]; + for j := 1 to NITEMS do + begin + EIGENVEC[i-1,j-1] := EVEC[i,j]; + end; + end; + EVEC := nil; + COMP := nil; + CU := nil; + ICL := nil; + PERVAR := nil; + DCORR := nil; + EVAL := nil; +end; + +procedure TMatManFrm.SymMatRoots(A: DynMat; M: integer; var E: DynVec; + var V: DynMat); +Label one, three, nine, fifteen; +var + L, IT, j, k : integer; + Test, sum1, sum2 : double; + X, Y, Z : DynVec; + +begin +// Adapted from: "Multivariate Data Analysis" by William W. Cooley and Paul +// R. Lohnes, 1971, page 121 + SetLength(X, M); + SetLength(Y, M); + SetLength(Z, M); + sum2 := 0.0; + L := 0; + Test := 0.00000001; +one: + IT := 0; + for j := 0 to M-1 do Y[j] := 1.0; +three: + IT := IT + 1; + for j := 0 to M-1 do + begin + X[j] := 0.0; + for k := 0 to M-1 do X[j] := X[j] + (A[j,k] * Y[k]); + end; + E[L] := X[0]; + Sum1 := 0.0; + for j := 0 to M-1 do + begin + V[j,L] := X[j] / X[0]; + Sum1 := Sum1 + abs(Y[j] - V[j,L]); + Y[j] := V[j,L]; + end; + if (IT - 10) <> 0 then goto nine; + if (Sum2 - Sum1) > 0 then goto nine + else + begin + showmessage('Root not converging. Exiting.'); + exit; + end; +nine: + Sum2 := Sum1; + if (Sum1 - Test) > 0 then goto three; + Sum1 := 0.0; + for j := 0 to M-1 do Sum1 := Sum1 + (V[j,L] * V[j,L]); + Sum1 := sqrt(Sum1); + for j := 0 to M-1 do V[j,L] := V[j,L] / Sum1; + for j := 0 to M-1 do + for k := 0 to M-1 do + A[j,k] := A[j,k] - (V[j,L] * V[k,L] * E[L]); + if ((M-1)-L) <= 0 then goto fifteen; + L := L + 1; + goto one; +fifteen: + Z := nil; + Y := nil; + X := nil; +end; + +function TMatManFrm.OpParse(var Operation: string; OpStr: string; + var Op1: string; var Op2: string; var Op3: string; var Opergrid: integer; + var Op1grid: integer; var Op2grid: integer; var Op3grid: integer): integer; +var + colonpos, dashpos : integer; + +begin + Operation := ''; + Op1 := ''; + Op2 := ''; + Op3 := ''; + colonpos := AnsiPos(':',OpStr); + if colonpos = 0 then + begin + ShowMessage('Operation code not found in a script entry.'); + result := 0; + exit; + end; + Operation := copy(OpStr,1,colonpos-1); + OpStr := copy(OpStr,colonpos+1,length(OpStr)); + colonpos := AnsiPos(':',OpStr); + + if colonpos > 0 then // more than one operand + begin + Op1 := copy(OpStr,1,colonpos-1); + OpStr := copy(OpStr,colonpos+1,length(OpStr)); + colonpos := AnsiPos(':',OpStr); + if colonpos > 0 then // more than two operands + begin + Op2 := copy(OpStr,1,colonpos-1); + Op3 := copy(OpStr,colonpos+1,length(OpStr)); + end + else Op2 := copy(OpStr,1,length(OpStr)); + end + else if length(OpStr) > 0 then Op1 := OpStr; + + // Now, strip the grid number for each part (n-) + // first, set defaults + Opergrid := 0; + Op1grid := 0; + Op2grid := 0; + Op3grid := 0; + dashpos := AnsiPos('-',Operation); + if dashpos > 0 then + begin + Opergrid := StrToInt(copy(Operation,dashpos-1,1)); + Operation := copy(Operation,dashpos+1,length(Operation)); + end; + dashpos := AnsiPos('-',Op1); + if dashpos > 0 then + begin + Op1grid := StrToInt(copy(Op1,dashpos-1,1)); + Op1 := copy(Op1,dashpos+1,length(Op1)); + end; + + dashpos := AnsiPos('-',Op2); + if dashpos > 0 then + begin + Op2grid := StrToInt(copy(Op2,dashpos-1,1)); + Op2 := copy(Op2,dashpos+1,length(Op2)); + end; + + dashpos := AnsiPos('-',Op3); + if dashpos > 0 then + begin + Op3grid := StrToInt(copy(Op3,dashpos-1,1)); + Op3 := copy(Op3,dashpos+3,length(Op3)); + end; + + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + Op3Edit.Text := Op2; + Op4Edit.Text := Op3; + result := 1; +end; + +procedure TMatManFrm.OperExec; +var + prompt, response : string; + SaveFile : TextFile; + +begin + if Opergrid > 0 then CurrentGrid := Opergrid; + Op2Edit.Text := ''; + Op2Edit.Text := ''; + Op4Edit.Text := ''; +{ + if Operation = 'FileOpen' then + begin + if Op1grid > 0 then Currentgrid := Op1grid; + OpenDialog1.FileName := Op1; + GetFile(Self); + end; + + if Operation = 'FileSave' then + begin + if Op1grid > 0 then Currentgrid := Op1grid; + SaveDialog1.FileName := Op1; + CurrentObjName := Op1; + mnuSaveClick(Self); + end; + + if Operation = 'KeyMatInput' then + begin + prompt := 'Input data matrix for ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then KeyMatClick(Self); + end; + + if Operation = 'KeyVecInput' then + begin + prompt := 'Input vector for ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then KeyVectClick(Self); + end; + + if Operation = 'KeyScalerInput' then + begin + prompt := 'Input the scaler ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then KeyScalerClick(Self); + end; +} + if Operation = 'RowAugment' then + begin + prompt := 'Row augment the matrix ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + RowAugMnuClick(Self); + end; + end; + + if Operation = 'ColAugment' then + begin + prompt := 'Column augment the matrix ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + ColAugMnuClick(Self); + end; + end; + + if Operation = 'DeleteRow' then + begin + prompt := 'Delete matrix row in ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + RowDelMnuClick(Self); + end; + end; + + if Operation = 'DeleteCol' then + begin + prompt := 'Delete matrix column in ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + ColDelMnuClick(Self); + end; + end; + + if Operation = 'SVDInverse' then + begin + prompt := 'Invert the matrix ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + SVDInvMnuClick(Self); + end; + end; + + if Operation = 'PreMatxPostMat' then + begin + prompt := 'Premultiply ' + Op1 + ' by ' + Op2 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + CurrentGrid := 1; + CurrentObjType := 1; + OpenDialog1.FileName := Op1; + GetFile(Self); + CurrentGrid := 2; + Op3Edit.Text := Op2; + OpenDialog1.FileName := Op2; + CurrentObjType := 1; + GetFile(Self); + Op4Edit.Text := Op3; + PreMatMnuClick(Self); + end; + end; + + if Operation = 'Tridiagonalize' then + begin + prompt := 'Tridiagonalize the matrix ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + TriDiagMnuClick(Self); + end; + end; + + if Operation = 'UpLowDecomp' then + begin + prompt := 'Obtain upper and lower decompositon of ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + ULDecompMnuClick(Self); + end; + end; + + if Operation = 'DiagToVec' then + begin + prompt := 'Copy diagonal of ' + Op1 + ' to vector ' + Op2 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + DiagtovecmnuClick(Self); + end; + end; + + if Operation = 'Determinant' then + begin + prompt := 'Obtain determinant of matrix ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + DetermMnuClick(Self); + end; + end; + + if Operation = 'MatTranspose' then + begin + prompt := 'Obtain transpose of matrix ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + TransMnuClick(Self); + end; + end; + + if Operation = 'MatrixRoots' then + begin + prompt := 'Obtain eigenvalues and vectors of matrix ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + EigenMnuClick(Self); + end; + end; + + if Operation = 'MatTrace' then + begin + prompt := 'Obtain trace of matrix ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + TraceMnuClick(Self); + end; + end; + + if Operation = 'NormalizeRows' then + begin + prompt := 'Normalize rows of matrix ' + Op1 + '?'; + response := InputBox('EXECUTE',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + NormRowsMnuClick(Self); + end; + end; + + if Operation = 'NormalizeCols' then + begin + prompt := 'Normalize columns of matrix ' + Op1 + '?'; + response := InputBox('EXECUTE',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + if Op1grid > 0 then CurrentGrid := Op1grid; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + NormColsMnuClick(Self); + end; + end; + + if Operation = 'MatMinusMat' then + begin + prompt := 'Subtract matrix ' + Op2 + ' from ' + Op1 + '?'; + response := InputBox('EXECUTE',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + CurrentGrid := 1; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + CurrentGrid := 2; + OpenDialog1.FileName := Op2; + CurrentObjType := 1; + GetFile(Self); + MatSubMnuClick(Self); + end; + end; + + if Operation = 'MatPlusMat' then + begin + prompt := 'Add matrix ' + Op1 + ' to ' + Op2 + '?'; + response := InputBox('EXECUTE',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + Currentgrid := 1; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + CurrentGrid := 2; + OpenDialog1.FileName := Op2; + CurrentObjType := 1; + GetFile(Self); + MatSumMnuClick(Self); + end; + end; + + if Operation = 'PreVecxPostMat' then + begin + prompt := 'Multiply matrix ' + Op1 + ' by row vector ' + Op2 + '?'; + response := InputBox('EXECUTE',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op2; + Currentgrid := 1; + OpenDialog1.FileName := Op2; + CurrentObjType := 3; + GetFile(Self); + CurrentGrid := 2; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + PrebyRowVmnuClick(Self); + end; + end; + + if Operation = 'ScalerxPostMat' then + begin + prompt := 'Multiply scaler ' + Op1 + ' times matrix ' + Op2 + '?'; + response := InputBox('EXECUTE',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + Currentgrid := 1; + OpenDialog1.FileName := Op1; + CurrentObjType := 4; + GetFile(Self); + CurrentGrid := 2; + Op3Edit.Text := Op2; + OpenDialog1.FileName := Op2; + CurrentObjType := 1; + GetFile(Self); + PreScalarMnuClick(Self); + end; + end; + + if Operation = 'PreMatxPostVec' then + begin + prompt := 'Multiply matrix ' + Op1 + ' by col.Vector ' + Op2 + '?'; + response := InputBox('EXECUTE',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + Currentgrid := 1; + CurrentObjType := 1; + OpenDialog1.FileName := Op1; + GetFile(Self); + CurrentGrid := 2; + Op3Edit.Text := Op2; + OpenDialog1.FileName := Op2; + CurrentObjType := 2; + GetFile(Self); + PostColVMnuClick(Self); + end; + end; + + if Operation = 'MatxPostMat' then + begin + prompt := 'Multiply matrix ' + Op1 + ' by matrix ' + Op2 + '?'; + response := InputBox('EXECUTE',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + Currentgrid := 1; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + CurrentGrid := 2; + Op3Edit.Text := Op2; + OpenDialog1.FileName := Op2; + CurrentObjType := 1; + GetFile(Self); + PostMatMnuClick(Self); + end; + end; + + if Operation = 'VectorTranspose' then + begin + prompt := 'Transpose vector ' + Op1 + '?'; + response := InputBox('EXECUTE',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + Currentgrid := 1; + OpenDialog1.FileName := Op1; + if FileExists(Op1) then + begin + AssignFile(SaveFile, Op1); + Reset(SaveFile); + Readln(SaveFile,CurrentObjType); + CloseFile(SaveFile); + end; + GetFile(Self); + VecTransMnuClick(Self); + end; + end; + + if Operation = 'ScalerxVector' then + begin + prompt := 'Multiply vector ' + Op2 + ' by scaler ' + Op1 + '?'; + response := InputBox('EXECUTE',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op2; + if FileExists(Op2) then + begin + AssignFile(SaveFile, Op2); + Reset(SaveFile); + Readln(SaveFile,CurrentObjType); + CloseFile(SaveFile); + end; + Currentgrid := 1; + OpenDialog1.FileName := Op2; + GetFile(Self); + Op3Edit.Text := Op1; + CurrentGrid := 2; + OpenDialog1.FileName := Op1; + CurrentObjType := 4; + GetFile(Self); + VecXscalarMnuClick(Self); + end; + end; + + if Operation = 'sqrtvector' then + begin + prompt := 'Square root of elements in vector ' + Op1 + '?'; + response := InputBox('EXECUTE',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + if FileExists(Op1) then + begin + AssignFile(SaveFile, Op1); + Reset(SaveFile); + Readln(SaveFile,CurrentObjType); + CloseFile(SaveFile); + end; + Currentgrid := 1; + OpenDialog1.FileName := Op1; + GetFile(Self); + VecSqrtMnuClick(Self); + end; + end; + + if Operation = 'VectorRecip' then + begin + prompt := 'Recipricol of elements in vector ' + Op1 + '?'; + response := InputBox('EXECUTE',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + if FileExists(Op1) then + begin + AssignFile(SaveFile, Op1); + Reset(SaveFile); + Readln(SaveFile,CurrentObjType); + CloseFile(SaveFile); + end; + Currentgrid := 1; + OpenDialog1.FileName := Op1; + GetFile(Self); + VecRecipMnuClick(Self); + end; + end; + + if Operation = 'VecxVec' then + begin + prompt := 'Multiply ' + Op1 + ' times ' + Op2 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + CurrentGrid := 1; + OpenDialog1.FileName := Op1; + if ExtractFileExt(Op1) = '.CVE' then + CurrentObjType := 2 + else CurrentObjType := 3; + GetFile(Self); + CurrentGrid := 2; + Op3Edit.Text := Op2; + OpenDialog1.FileName := Op2; + if ExtractFileExt(Op2) = '.CVE' then + CurrentObjType := 2 + else CurrentObjType := 3; + GetFile(Self); + Op4Edit.Text := Op3; + RowxColVecMnuClick(Self); + end; + end; + + if Operation = 'SqrtScaler' then + begin + prompt := 'Square root of scaler ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + CurrentGrid := 1; + OpenDialog1.FileName := Op1; + CurrentObjType := 4; + GetFile(Self); + ScalSqrtMnuClick(Self); + end; + end; + + If Operation = 'ScalerRecip' then + begin + prompt := 'Recipricol of scaler ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + CurrentGrid := 1; + OpenDialog1.FileName := Op1; + CurrentObjType := 4; + GetFile(Self); + ScalRecipMnuClick(Self); + end; + end; + + if Operation = 'ScalerProd' then + begin + prompt := 'Multiply ' + Op1 + ' by a value?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + CurrentGrid := 1; + OpenDialog1.FileName := Op1; + CurrentObjType := 4; + GetFile(Self); + ScalxScalMnuClick(Self); + end; + end; + + if Operation = 'ExtractVector' then + begin + prompt := 'Extract ' + Op2 + ' from ' + Op1 + '?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + CurrentGrid := 1; + OpenDialog1.FileName := Op1; + CurrentObjType := 1; + GetFile(Self); + ExtractColVecMnuClick(Self); + end; + end; + + if Operation = 'VecToDiag' then + begin + prompt := 'Place ' + Op1 + ' into diagonal of matrix' + Op2 +'?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then + begin + Op1Edit.Text := Operation; + Op2Edit.Text := Op1; + CurrentGrid := 1; + OpenDialog1.FileName := Op1; + if ExtractFileExt(Op1) = '.CVE' then + CurrentObjType := 2 + else if ExtractFileExt(Op1) = '.RVE' then + CurrentObjType := 3 + else exit; + GetFile(Self); + Op3Edit.Text := Op2; + CurrentGrid := 2; + OpenDialog1.FileName := Op2; + CurrentObjType := 1; + GetFile(Self); + Vec2DiagMnuClick(Self); + end; + end; + + if Operation = 'IDMAT' then + begin + prompt := 'Create an Identity Matrix?'; + response := InputBox('EXECUTE?',prompt,'Y'); + if response = 'Y' then IdentMnuClick(Self); + end; + + Operation := ''; +end; + +initialization + {$I matmanunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/matrix_manipulation/rootmethodunit.lfm b/applications/lazstats/source/forms/analysis/matrix_manipulation/rootmethodunit.lfm new file mode 100644 index 000000000..7ccce6945 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/matrix_manipulation/rootmethodunit.lfm @@ -0,0 +1,103 @@ +object RootMethodFrm: TRootMethodFrm + Left = 588 + Height = 205 + Top = 306 + Width = 524 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Method to Obtain Roots' + ClientHeight = 205 + ClientWidth = 524 + OnActivate = FormActivate + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object MethodGroup: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 143 + Top = 8 + Width = 509 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'METHOD:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 4 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 123 + ClientWidth = 505 + ItemIndex = 0 + Items.Strings = ( + 'Use Veldman''s SEVS routine - Symetric matrix, unnormalized vectors, positive roots' + 'Use Veldman''s AEVS routine - Nonsymetric matrix, unnormalized vectors, positive roots' + 'Use Cooley-Lohnes ITER routine - Symetric matrix, normalized vectors, positive roots' + 'Use Numerical Recipes routine - Symetric matrix, normalized vectors, positive roots' + 'Use IMSL routine - Symetric Matrix, normalized vectors' + ) + TabOrder = 0 + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Bevel2 + Left = 192 + Height = 25 + Top = 171 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 12 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + object ReturnBtn: TButton + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + Left = 270 + Height = 25 + Top = 171 + Width = 61 + AutoSize = True + BorderSpacing.Top = 12 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 2 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = MethodGroup + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 151 + Width = 524 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + Left = 254 + Height = 27 + Top = 159 + Width = 16 + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/matrix_manipulation/rootmethodunit.pas b/applications/lazstats/source/forms/analysis/matrix_manipulation/rootmethodunit.pas new file mode 100644 index 000000000..599013402 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/matrix_manipulation/rootmethodunit.pas @@ -0,0 +1,55 @@ +unit RootMethodUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls; + +type + + { TRootMethodFrm } + + TRootMethodFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + CancelBtn: TButton; + ReturnBtn: TButton; + MethodGroup: TRadioGroup; + procedure FormActivate(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + Choice : integer; + end; + +var + RootMethodFrm: TRootMethodFrm; + +implementation + +uses + Math; + +{ TRootMethodFrm } + +procedure TRootMethodFrm.FormActivate(Sender: TObject); +begin + CancelBtn.Constraints.MinWidth := Max(CancelBtn.Width, ReturnBtn.Width); + ReturnBtn.Constraints.MinWidth := CancelBtn.Constraints.MinWidth; +end; + +procedure TRootMethodFrm.ReturnBtnClick(Sender: TObject); +begin + Choice := MethodGroup.ItemIndex + 1; +end; + +initialization + {$I rootmethodunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/matrix_manipulation/rowinsertunit.lfm b/applications/lazstats/source/forms/analysis/matrix_manipulation/rowinsertunit.lfm new file mode 100644 index 000000000..8db3f582a --- /dev/null +++ b/applications/lazstats/source/forms/analysis/matrix_manipulation/rowinsertunit.lfm @@ -0,0 +1,143 @@ +object RowInsertFrm: TRowInsertFrm + Left = 649 + Height = 153 + Top = 298 + Width = 256 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Row Insert' + ClientHeight = 153 + ClientWidth = 256 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideTop.Control = GridNoEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = GridNoEdit + Left = 35 + Height = 15 + Top = 12 + Width = 147 + Anchors = [akTop, akRight] + BorderSpacing.Left = 24 + BorderSpacing.Right = 8 + Caption = 'Insert a Row in Which Grid? ' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = BeforeEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = BeforeEdit + Left = 96 + Height = 15 + Top = 45 + Width = 86 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Before the Row :' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = AfterEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = AfterEdit + Left = 101 + Height = 15 + Top = 80 + Width = 81 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'After the Row : ' + ParentColor = False + end + object GridNoEdit: TEdit + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 190 + Height = 23 + Top = 8 + Width = 42 + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 24 + TabOrder = 0 + Text = 'GridNoEdit' + end + object BeforeEdit: TEdit + AnchorSideLeft.Control = GridNoEdit + AnchorSideRight.Control = GridNoEdit + AnchorSideRight.Side = asrBottom + Left = 190 + Height = 23 + Top = 41 + Width = 42 + Anchors = [akTop, akLeft, akRight] + TabOrder = 1 + Text = 'BeforeEdit' + end + object AfterEdit: TEdit + AnchorSideLeft.Control = GridNoEdit + AnchorSideRight.Control = GridNoEdit + AnchorSideRight.Side = asrBottom + Left = 190 + Height = 23 + Top = 76 + Width = 42 + Anchors = [akTop, akLeft, akRight] + TabOrder = 2 + Text = 'AfterEdit' + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 109 + Height = 25 + Top = 119 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 3 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 183 + Height = 25 + Top = 119 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 4 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = AfterEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 103 + Width = 256 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/matrix_manipulation/rowinsertunit.pas b/applications/lazstats/source/forms/analysis/matrix_manipulation/rowinsertunit.pas new file mode 100644 index 000000000..f72933fad --- /dev/null +++ b/applications/lazstats/source/forms/analysis/matrix_manipulation/rowinsertunit.pas @@ -0,0 +1,70 @@ +unit RowInsertUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls; + +type + + { TRowInsertFrm } + + TRowInsertFrm = class(TForm) + BeforeEdit: TEdit; + AfterEdit: TEdit; + Bevel1: TBevel; + CancelBtn: TButton; + ReturnBtn: TButton; + GridNoEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + RowInsertFrm: TRowInsertFrm; + +implementation + +uses + Math, MatManUnit; + +{ TRowInsertFrm } + +procedure TRowInsertFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([CancelBtn.Width, ReturnBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure TRowInsertFrm.FormCreate(Sender: TObject); +begin + if MatManFrm = nil then + Application.CreateForm(TMatManFrm, MatManFrm); +end; + +procedure TRowInsertFrm.FormShow(Sender: TObject); +begin + BeforeEdit.Text := ''; + AfterEdit.Text := ''; + GridNoEdit.Text := matmanfrm.GridNoEdit.Text; +end; + +initialization + {$I rowinsertunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/matrix_manipulation/scripteditorunit.lfm b/applications/lazstats/source/forms/analysis/matrix_manipulation/scripteditorunit.lfm new file mode 100644 index 000000000..daec7fecc --- /dev/null +++ b/applications/lazstats/source/forms/analysis/matrix_manipulation/scripteditorunit.lfm @@ -0,0 +1,274 @@ +object ScriptEditorFrm: TScriptEditorFrm + Left = 436 + Height = 510 + Top = 191 + Width = 528 + AutoSize = True + Caption = 'MatMan Script Editor' + ClientHeight = 510 + ClientWidth = 528 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ScriptFileEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ScriptFileEdit + Left = 8 + Height = 15 + Top = 69 + Width = 135 + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Current Script File Name: ' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ScriptFileEdit + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 96 + Width = 73 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Current Script' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = RadioGroup1 + AnchorSideTop.Control = LineEdit + AnchorSideTop.Side = asrBottom + Left = 268 + Height = 15 + Top = 249 + Width = 74 + BorderSpacing.Top = 8 + Caption = 'Directory Files' + ParentColor = False + end + object ScriptFileEdit: TEdit + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 154 + Height = 23 + Top = 65 + Width = 366 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + TabOrder = 0 + Text = 'ScriptFileEdit' + end + object ScriptList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = HorCenterBevel + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 348 + Top = 113 + Width = 252 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + OnClick = ScriptListClick + TabOrder = 1 + end + object RadioGroup1: TRadioGroup + AnchorSideLeft.Control = HorCenterBevel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 268 + Height = 114 + Top = 96 + Width = 252 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Editing Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 94 + ClientWidth = 248 + Items.Strings = ( + 'Delete the line' + 'Insert a new line prior to selected line' + 'Modify the current line' + 'Append another script' + ) + OnClick = RadioGroup1Click + TabOrder = 2 + end + object FileListBox1: TFileListBox + AnchorSideLeft.Control = RadioGroup1 + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel2 + Left = 268 + Height = 195 + Top = 266 + Width = 252 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Directory = 'C:\Windows\system32' + ItemHeight = 15 + OnDblClick = FileListBox1DblClick + TabOrder = 3 + end + object SaveBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 319 + Height = 25 + Top = 477 + Width = 50 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Save' + OnClick = SaveBtnClick + TabOrder = 4 + end + object CancelBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 381 + Height = 25 + Top = 477 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 5 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 455 + Height = 25 + Top = 477 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 6 + end + object DirChangeBtn: TButton + AnchorSideRight.Control = SaveBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 189 + Height = 25 + Top = 477 + Width = 118 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Change Directory' + OnClick = DirChangeBtnClick + TabOrder = 7 + end + object LineEdit: TEdit + AnchorSideLeft.Control = RadioGroup1 + AnchorSideTop.Control = RadioGroup1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = RadioGroup1 + AnchorSideRight.Side = asrBottom + Left = 268 + Height = 23 + Top = 218 + Width = 252 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + OnKeyPress = LineEditKeyPress + TabOrder = 8 + Text = 'LineEdit' + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 45 + Top = 8 + Width = 512 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Your script is shown in the list to your left. Select a line by clicking on a line in the script and then click on one of the edit option buttons.'#13#10'When finished editing, click on the Save button.' + ParentColor = False + WordWrap = True + end + object HorCenterBevel: TBevel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 260 + Height = 82 + Top = 232 + Width = 8 + Shape = bsSpacer + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 461 + Width = 528 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object SaveDialog1: TSaveDialog + left = 160 + top = 168 + end + object OpenDialog1: TOpenDialog + left = 160 + top = 240 + end + object SelectDirectoryDialog1: TSelectDirectoryDialog + left = 160 + top = 312 + end +end diff --git a/applications/lazstats/source/forms/analysis/matrix_manipulation/scripteditorunit.pas b/applications/lazstats/source/forms/analysis/matrix_manipulation/scripteditorunit.pas new file mode 100644 index 000000000..699f7076c --- /dev/null +++ b/applications/lazstats/source/forms/analysis/matrix_manipulation/scripteditorunit.pas @@ -0,0 +1,224 @@ +unit ScriptEditorUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, FileCtrl; + +type + + { TScriptEditorFrm } + + TScriptEditorFrm = class(TForm) + HorCenterBevel: TBevel; + Bevel2: TBevel; + DirChangeBtn: TButton; + LineEdit: TEdit; + Memo1: TLabel; + OpenDialog1: TOpenDialog; + SaveBtn: TButton; + CancelBtn: TButton; + ReturnBtn: TButton; + FileListBox1: TFileListBox; + Label2: TLabel; + Label3: TLabel; + RadioGroup1: TRadioGroup; + SaveDialog1: TSaveDialog; + ScriptList: TListBox; + ScriptFileEdit: TEdit; + Label1: TLabel; + SelectDirectoryDialog1: TSelectDirectoryDialog; + procedure DirChangeBtnClick(Sender: TObject); + procedure FileListBox1DblClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure LineEditKeyPress(Sender: TObject; var Key: char); + procedure RadioGroup1Click(Sender: TObject); + procedure SaveBtnClick(Sender: TObject); + procedure ScriptListClick(Sender: TObject); + private + { private declarations } + EditOption : integer; + index : integer; + currdir : string; + public + { public declarations } + end; + +var + ScriptEditorFrm: TScriptEditorFrm; + +implementation + +uses + Math, + MatManUnit; + +{ TScriptEditorFrm } + +procedure TScriptEditorFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([SaveBtn.Width, CancelBtn.Width, ReturnBtn.Width]); + SaveBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure TScriptEditorFrm.FormShow(Sender: TObject); +begin + //Label4.Visible := false; + LineEdit.Visible := false; +// currdir := GetCurrentDir; +// FileListBox1.Directory := currdir; +end; + +procedure TScriptEditorFrm.FileListBox1DblClick(Sender: TObject); +var + delfile, prmptstr, info : string; + aindex : integer; + +begin + aindex := FileListBox1.ItemIndex; + delfile := FileListBox1.Items.Strings[aindex]; + prmptstr := 'Delete ' + delfile + '?'; + info := InputBox('DELETE?',prmptstr,'Y'); + if info <> 'Y' then exit + else DeleteFile(delfile); + FileListBox1.Update; +end; + +procedure TScriptEditorFrm.DirChangeBtnClick(Sender: TObject); +begin + if SelectDirectoryDialog1.Execute then + begin + currdir := GetCurrentDir; + FileListBox1.Directory := currdir; + end; +end; + +procedure TScriptEditorFrm.LineEditKeyPress(Sender: TObject; var Key: char); +begin + if ord(Key) = 13 then + begin + ScriptList.Items.Insert(index,LineEdit.Text); + LineEdit.Text := ''; + LineEdit.Visible := false; + Label3.Visible := false; + end; +end; + +procedure TScriptEditorFrm.RadioGroup1Click(Sender: TObject); +var + SaveFile : TextFile; + CurrentObjType : integer; + CurrentObjName, cellstring : string; + Count, i : integer; + +begin + EditOption := RadioGroup1.ItemIndex + 1; + case EditOption of + 1 : begin // delete a line + label3.Visible := false; + LineEdit.Visible := false; + ScriptList.Items.Delete(index); + ScriptList.SetFocus; + RadioGroup1.ItemIndex := -1; + end; + 2 : begin // insert a line + label3.Visible := true; + label3.Caption := 'Enter a new line. End by pressing the Enter key.'; + LineEdit.Visible := true; + LineEdit.Text := ''; + LineEdit.SetFocus; + RadioGroup1.ItemIndex := -1; + end; + 3 : begin // edit a line + label3.Visible := true; + label3.Caption := 'Edit the line. End by pressing the Enter key.'; + LineEdit.Visible := true; + if index >= 0 then + begin + LineEdit.Text := ScriptList.Items.Strings[index]; + ScriptList.Items.Delete(index); + LineEdit.SetFocus; + end; + RadioGroup1.ItemIndex := -1; + end; + 4 : begin // append another script file + OpenDialog1.DefaultExt := '.SCP'; + OpenDialog1.Filter := 'Script (*.SCP)|*.SCP|All (*.*)|*.*'; + OpenDialog1.FilterIndex := 1; + if OpenDialog1.Execute then + begin + AssignFile(SaveFile, OpenDialog1.FileName); + Reset(SaveFile); + Readln(SaveFile,CurrentObjType); + if CurrentObjType <> 5 then + begin + ShowMessage('Not a script file!'); + CloseFile(SaveFile); + exit; + end; + Readln(SaveFile,CurrentObjName); + Readln(SaveFile,Count); + for i := 0 to Count - 1 do + begin + Readln(SaveFile,cellstring); + ScriptList.Items.Add(cellstring); + end; + CloseFile(SaveFile); + end; + end; // end case 4 + end; // end cases +end; + +procedure TScriptEditorFrm.SaveBtnClick(Sender: TObject); +var + SaveFile : TextFile; + i, Count, CurrentObjType : integer; + CurrentObjName, edititem : string; + +begin + Assert(MatManFrm <> nil); + + Count := ScriptList.Items.Count; + if Count < 1 then exit; + CurrentObjType := 5; + CurrentObjName := ScriptFileEdit.Text; + SaveDialog1.FileName := ScriptFileEdit.Text; + SaveDialog1.Filter := 'Script (*.SCP)|*.SCP|All(*.*)|*.*'; + SaveDialog1.DefaultExt := '.SCP'; + SaveDialog1.FilterIndex := 1; + if SaveDialog1.Execute then + begin + AssignFile(SaveFile, SaveDialog1.FileName); + Rewrite(SaveFile); + Writeln(SaveFile,CurrentObjType); + Writeln(SaveFile,CurrentObjName); + Writeln(SaveFile,Count); + MatManFrm.ScriptList.Clear; + for i := 0 to Count - 1 do + begin + edititem := ScriptList.Items.Strings[i]; + Writeln(SaveFile,edititem); + MatManFrm.ScriptList.Items.Add(edititem); + end; + CloseFile(SaveFile); + end; +end; + +procedure TScriptEditorFrm.ScriptListClick(Sender: TObject); +begin + index := ScriptList.ItemIndex; +end; + +initialization + {$I scripteditorunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/matrix_manipulation/scriptoptsunit.lfm b/applications/lazstats/source/forms/analysis/matrix_manipulation/scriptoptsunit.lfm new file mode 100644 index 000000000..fb05e8751 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/matrix_manipulation/scriptoptsunit.lfm @@ -0,0 +1,88 @@ +object ScriptOptsFrm: TScriptOptsFrm + Left = 695 + Height = 125 + Top = 337 + Width = 281 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Script Options' + ClientHeight = 125 + ClientWidth = 281 + OnActivate = FormActivate + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CheckGroup1: TCheckGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 72 + Top = 8 + Width = 265 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 261 + Items.Strings = ( + 'Do NOT record file Open Operations' + 'Do NOT record file Save Operations' + ) + TabOrder = 0 + Data = { + 020000000202 + } + end + object CancelBtn: TButton + AnchorSideTop.Control = CheckGroup1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Side = asrBottom + Left = 138 + Height = 25 + Top = 88 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + object ReturnBtn: TButton + AnchorSideTop.Control = CheckGroup1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 212 + Height = 25 + Top = 88 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 2 + end +end diff --git a/applications/lazstats/source/forms/analysis/matrix_manipulation/scriptoptsunit.pas b/applications/lazstats/source/forms/analysis/matrix_manipulation/scriptoptsunit.pas new file mode 100644 index 000000000..6967d9dad --- /dev/null +++ b/applications/lazstats/source/forms/analysis/matrix_manipulation/scriptoptsunit.pas @@ -0,0 +1,64 @@ +unit ScriptOptsUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls; + +type + + { TScriptOptsFrm } + + TScriptOptsFrm = class(TForm) + CancelBtn: TButton; + ReturnBtn: TButton; + CheckGroup1: TCheckGroup; + procedure FormActivate(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + ScriptOptsFrm: TScriptOptsFrm; + +implementation + +uses + Math; + +{ TScriptOptsFrm } + +procedure TScriptOptsFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([CancelBtn.Width, ReturnBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure TScriptOptsFrm.ReturnBtnClick(Sender: TObject); +var + scriptopts : textfile; + checked : integer; +begin + AssignFile(scriptopts, 'Options.SCR'); + Rewrite(scriptopts); + if CheckGroup1.Checked[0] then checked := 1 else checked := 0; + Writeln(scriptopts,checked); + if CheckGroup1.Checked[1] then checked := 1 else checked := 0; + Writeln(scriptopts,checked); + closefile(scriptopts); +end; + +initialization + {$I scriptoptsunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/comprelunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/comprelunit.lfm new file mode 100644 index 000000000..c3f77e139 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/comprelunit.lfm @@ -0,0 +1,329 @@ +object CompRelFrm: TCompRelFrm + Left = 506 + Height = 361 + Top = 429 + Width = 583 + AutoSize = True + Caption = 'Composite Test Reliability' + ClientHeight = 361 + ClientWidth = 583 + OnActivate = FormActivate + OnCreate = FormCreate + OnResize = FormResize + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label3: TLabel + AnchorSideLeft.Control = RelList + AnchorSideTop.Control = Owner + Left = 308 + Height = 15 + Top = 8 + Width = 74 + BorderSpacing.Top = 8 + Caption = 'Test Reliability' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = WeightList + AnchorSideTop.Control = Owner + Left = 460 + Height = 15 + Top = 8 + Width = 66 + BorderSpacing.Top = 8 + Caption = 'Test Weights' + ParentColor = False + end + object RelList: TListBox + AnchorSideLeft.Control = ItemList + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = WeightList + AnchorSideBottom.Side = asrBottom + Left = 308 + Height = 228 + Top = 25 + Width = 144 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnClick = RelListClick + TabOrder = 5 + end + object WeightList: TListBox + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 460 + Height = 228 + Top = 25 + Width = 115 + Anchors = [akTop, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnClick = WeightListClick + TabOrder = 6 + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 51 + Top = 261 + Width = 387 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 24 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 31 + ClientWidth = 383 + TabOrder = 7 + object RMatChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 166 + Caption = 'Print Intercorrelation Matrix' + TabOrder = 0 + end + object GridScrChk: TCheckBox + Left = 202 + Height = 19 + Top = 6 + Width = 169 + Caption = 'Put Composite Score in Grid' + TabOrder = 1 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 286 + Height = 25 + Top = 328 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 9 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 352 + Height = 25 + Top = 328 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 10 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 426 + Height = 25 + Top = 328 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 11 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 514 + Height = 25 + Top = 328 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 12 + end + object HelpBtn: TButton + Tag = 114 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 223 + Height = 25 + Top = 328 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 8 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 312 + Width = 583 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables Available' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ItemList + AnchorSideTop.Control = Owner + Left = 185 + Height = 15 + Top = 8 + Width = 76 + BorderSpacing.Top = 8 + Caption = 'Selected Items' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 228 + Top = 25 + Width = 115 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 140 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 140 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrCenter + Left = 131 + Height = 25 + Top = 127 + Width = 46 + AutoSize = True + Caption = 'ALL' + OnClick = AllBtnClick + TabOrder = 3 + end + object ItemList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 185 + Height = 228 + Top = 25 + Width = 115 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + TabOrder = 4 + end + object Bevel2: TBevel + AnchorSideLeft.Control = VarList + AnchorSideRight.Control = ItemList + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 8 + Top = 3 + Width = 292 + Anchors = [akTop, akLeft, akRight] + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/comprelunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/comprelunit.pas new file mode 100644 index 000000000..75a829a03 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/comprelunit.pas @@ -0,0 +1,347 @@ +unit CompRelUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, Globals, DataProcs, MatrixLib, + DictionaryUnit, ContextHelpUnit; + +type + + { TCompRelFrm } + + TCompRelFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + HelpBtn: TButton; + InBtn: TBitBtn; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + RMatChk: TCheckBox; + GridScrChk: TCheckBox; + GroupBox1: TGroupBox; + Label1: TLabel; + Label2: TLabel; + ItemList: TListBox; + Label3: TLabel; + Label4: TLabel; + WeightList: TListBox; + RelList: TListBox; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormResize(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure RelListClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure WeightListClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + CompRelFrm: TCompRelFrm; + +implementation + +uses + Math; +{ TCompRelFrm } + +procedure TCompRelFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + ItemList.Clear; + RelList.Clear; + WeightList.Clear; + OutBtn.Enabled := false; + InBtn.Enabled := true; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TCompRelFrm.WeightListClick(Sender: TObject); +var + response : string; + index : integer; +begin + response := InputBox('Test Weight','Test weight = ','1.0'); + index := WeightList.ItemIndex; + WeightList.Items.Strings[index] := response; +end; + +procedure TCompRelFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + w := Max(Label1.Width, Label3.Width); + VarList.Constraints.MinWidth := w; + ItemList.constraints.MinWidth := w; + RelList.Constraints.MinWidth := w; + WeightList.Constraints.MinWidth := 2; + + //AutoSize := false; + Constraints.MinHeight := Height; + Width := 4 * w + AllBtn.Width + 6 * VarList.BorderSpacing.Left; + Constraints.MinWidth := Width; + + FAutoSized := True; +end; + +procedure TCompRelFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TCompRelFrm.FormResize(Sender: TObject); +var + w: Integer; +begin + w := (Width - AllBtn.Width - 6*VarList.BorderSpacing.Left) div 4; + VarList.Width := w; + ItemList.Width := w; + RelList.Width := w; + WeightList.Width := w; +end; + +procedure TCompRelFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TCompRelFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContexthelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TCompRelFrm.AllBtnClick(Sender: TObject); +var + i, count : integer; + cellstring : string; +begin + count := VarList.Items.Count; + for i := 1 to count do + begin + ItemList.Items.Add(VarList.Items.Strings[i-1]); + cellstring := '1.0'; + RelList.Items.Add(cellstring); + WeightList.Items.Add(cellstring); + end; + VarList.Clear; + InBtn.Enabled := false; + OutBtn.Enabled := true; +end; + +procedure TCompRelFrm.ComputeBtnClick(Sender: TObject); +var + i, j, NoVars, count, col : integer; + Rmat, RelMat : DblDyneMat; + Weights, Reliabilities, VectProd, means, variances, stddevs : DblDyneVec; + CompRel, numerator, denominator, compscore : double; + colnoselected : IntDyneVec; + outline, cellstring : string; + title : string; + RowLabels : StrDyneVec; + errorcode : boolean = false; +begin + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + + SetLength(colnoselected,NoVariables); + SetLength(Rmat,NoVariables+1,NoVariables+1); + SetLength(RelMat,NoVariables+1,NoVariables+1); + SetLength(Weights,NoVariables); + SetLength(Reliabilities,NoVariables); + SetLength(VectProd,NoVariables); + SetLength(means,NoVariables); + SetLength(variances,NoVariables); + SetLength(stddevs,NoVariables); + SetLength(RowLabels,NoVariables); + + OutputFrm.RichEdit.Clear; + // get variable col. no.s selected + NoVars := ItemList.Items.Count; + for i := 1 to NoVars do + begin + cellstring := ItemList.Items.Strings[i-1]; + for j := 1 to NoVariables do + begin + if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then + begin + colnoselected[i-1] := j; + RowLabels[i-1] := cellstring; + end; + end; + end; + count := NoCases; + + OutputFrm.RichEdit.Lines.Add('Composite Test Reliability'); + OutputFrm.RichEdit.Lines.Add(''); + outline := 'File Analyzed: ' + OS3MainFrm.FileNameEdit.Text; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + // get correlation matrix + Correlations(NoVars,colnoselected,Rmat,means,variances,stddevs,errorcode,count); + if (errorcode) then + ShowMessage('ERROR! Zero variance found for a variable.'); + if RmatChk.Checked then + begin + title := 'Correlations Among Tests'; + MAT_PRINT(Rmat,NoVars,NoVars,title,RowLabels,RowLabels,count); + title := 'Means'; + DynVectorPrint(means,NoVars,title,RowLabels,count); + title := 'Variances'; + DynVectorPrint(variances,NoVars,title,RowLabels,count); + title := 'Standard Deviations'; + DynVectorPrint(stddevs,NoVars,title,RowLabels,count); + end; + for i := 1 to NoVars do + for j := 1 to NoVars do + RelMat[i-1,j-1] := Rmat[i-1,j-1]; + for i := 1 to NoVars do + begin + Reliabilities[i-1] := StrToFloat(RelList.Items.Strings[i-1]); + RelMat[i-1,i-1] := Reliabilities[i-1]; + Weights[i-1] := StrToFloat(WeightList.Items.Strings[i-1]); + end; + // get numerator and denominator of composite reliability + for i := 1 to NoVars do VectProd[i-1] := 0.0; + numerator := 0.0; + denominator := 0.0; + for i := 1 to NoVars do + for j := 1 to NoVars do + VectProd[i-1] := VectProd[i-1] + (Weights[i-1] * RelMat[j-1,i-1]); + for i := 1 to NoVars do numerator := numerator + (VectProd[i-1] * Weights[i-1]); + + for i := 1 to NoVars do VectProd[i-1] := 0.0; + for i := 1 to NoVars do + for j := 1 to NoVars do + VectProd[i-1] := VectProd[i-1] + (Weights[i-1] * Rmat[j-1,i-1]); + for i := 1 to NoVars do denominator := denominator + + (VectProd[i-1] * Weights[i-1]); + CompRel := numerator / denominator; + OutputFrm.RichEdit.Lines.Add(''); + title := 'Test Weights'; + DynVectorPrint(Weights,NoVars,title,RowLabels,count); + title := 'Test Reliabilities'; + DynVectorPrint(Reliabilities,NoVars,title,RowLabels,count); + outline := format('Composite reliability = %6.3f',[CompRel]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + if GridScrChk.Checked then + begin + cellstring := 'Composite'; + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := cellstring; + col := NoVariables; + OS3MainFrm.DataGrid.Cells[col,0] := cellstring; + col := NoVariables; + for i := 1 to NoCases do + begin + compscore := 0.0; + if not GoodRecord(i,NoVars,ColNoSelected) then continue; + for j := 1 to NoVars do + begin + compscore := compscore + (Weights[j-1] * + StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[colnoselected[j-1],i]))); + end; + OS3MainFrm.DataGrid.Cells[col,i] := FloatToStr(compscore); + end; + end; + + RowLabels := nil; + stddevs := nil; + variances := nil; + means := nil; + VectProd := nil; + Reliabilities := nil; + Weights := nil; + RelMat := nil; + Rmat := nil; + colnoselected := nil; +end; + +procedure TCompRelFrm.InBtnClick(Sender: TObject); +var + index, i : integer; + cellstring : string; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + ItemList.Items.Add(VarList.Items.Strings[i]); + cellstring := '1.0'; + RelList.Items.Add(cellstring); + WeightList.Items.Add(cellstring); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + OutBtn.Enabled := true; +end; + +procedure TCompRelFrm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := ItemList.ItemIndex; + if index < 0 then + begin + OutBtn.Enabled := false; + exit; + end; + VarList.Items.Add(ItemList.Items.Strings[index]); + ItemList.Items.Delete(index); + RelList.Items.Delete(index); + WeightList.Items.Delete(index); +end; + +procedure TCompRelFrm.RelListClick(Sender: TObject); +var + response : string; + index : integer; +begin + response := InputBox('Reliability','Reliability estimate = ','1.0'); + index := RelList.ItemIndex; + RelList.Items.Strings[index] := response; +end; + +initialization + {$I comprelunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/difunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/difunit.lfm new file mode 100644 index 000000000..651238744 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/difunit.lfm @@ -0,0 +1,659 @@ +object DIFFrm: TDIFFrm + Left = 573 + Height = 296 + Top = 253 + Width = 748 + Caption = 'DIF Specifications' + ClientHeight = 296 + ClientWidth = 748 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideTop.Control = Owner + AnchorSideRight.Control = GroupBox2 + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 368 + Height = 235 + Top = 8 + Width = 165 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 4 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 215 + ClientWidth = 161 + TabOrder = 1 + object ItemStatsChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 137 + Caption = 'Item Statistics' + TabOrder = 0 + end + object TestStatsChk: TCheckBox + Left = 12 + Height = 19 + Top = 29 + Width = 137 + Caption = 'Test Statistics' + TabOrder = 1 + end + object ItemCorrsChk: TCheckBox + Left = 12 + Height = 19 + Top = 52 + Width = 137 + Caption = 'Item Intercorrelations' + TabOrder = 2 + end + object ItemTestChk: TCheckBox + Left = 12 + Height = 19 + Top = 75 + Width = 137 + Caption = 'Item-Test Correlations' + TabOrder = 3 + end + object AlphaChk: TCheckBox + Left = 12 + Height = 19 + Top = 98 + Width = 137 + Caption = 'Alpha Reliability' + TabOrder = 4 + end + object MHChk: TCheckBox + Left = 12 + Height = 19 + Top = 121 + Width = 137 + Caption = 'Mantel-Haenszel' + TabOrder = 5 + end + object LogisticChk: TCheckBox + Left = 12 + Height = 19 + Top = 144 + Width = 137 + Caption = 'Logistic Regression' + TabOrder = 6 + end + object CurvesChk: TCheckBox + Left = 12 + Height = 19 + Top = 167 + Width = 137 + Caption = 'Item Char. Curves' + TabOrder = 7 + end + object CountsChk: TCheckBox + Left = 12 + Height = 19 + Top = 190 + Width = 137 + Caption = 'Level Counts' + TabOrder = 8 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 447 + Height = 25 + Top = 263 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 513 + Height = 25 + Top = 263 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 6 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 587 + Height = 25 + Top = 263 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 7 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 675 + Height = 25 + Top = 263 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 8 + end + object HelpBtn: TButton + Tag = 122 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 384 + Height = 25 + Top = 263 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 4 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 247 + Width = 748 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = GroupBox1 + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 239 + Top = 8 + Width = 352 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 239 + ClientWidth = 352 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = Panel1 + Left = 211 + Height = 15 + Top = 0 + Width = 76 + Caption = 'Items Selected' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = ItemsList + AnchorSideBottom.Control = GroupVarEdit + Left = 207 + Height = 15 + Top = 171 + Width = 94 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Grouping Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 222 + Top = 17 + Width = 145 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object ItemInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 162 + Height = 28 + Top = 33 + Width = 28 + BorderSpacing.Top = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ItemInBtnClick + Spacing = 0 + TabOrder = 1 + end + object ItemOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ItemInBtn + AnchorSideTop.Side = asrBottom + Left = 162 + Height = 28 + Top = 65 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ItemOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ItemOutBtn + AnchorSideTop.Side = asrBottom + Left = 153 + Height = 25 + Top = 97 + Width = 46 + AutoSize = True + BorderSpacing.Top = 4 + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 3 + end + object GrpInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = GrpOutBtn + Left = 162 + Height = 28 + Top = 163 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = GrpInBtnClick + Spacing = 0 + TabOrder = 5 + end + object GrpOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 162 + Height = 28 + Top = 195 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 16 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = GrpOutBtnClick + Spacing = 0 + TabOrder = 6 + end + object ItemsList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GrpInBtn + Left = 207 + Height = 122 + Top = 17 + Width = 145 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 24 + ItemHeight = 0 + TabOrder = 4 + end + object GroupVarEdit: TEdit + AnchorSideLeft.Control = ItemsList + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GrpOutBtn + AnchorSideBottom.Side = asrBottom + Left = 207 + Height = 23 + Top = 188 + Width = 145 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 12 + TabOrder = 7 + Text = 'GroupVarEdit' + end + end + object Panel2: TPanel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = GroupBox2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 565 + Height = 77 + Top = 162 + Width = 175 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + BevelOuter = bvNone + ClientHeight = 77 + ClientWidth = 175 + TabOrder = 3 + object Label4: TLabel + AnchorSideTop.Control = RefGrpEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = RefGrpEdit + Left = 9 + Height = 15 + Top = 4 + Width = 124 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Reference Group Code?' + ParentColor = False + end + object Label5: TLabel + AnchorSideTop.Control = TrgtGrpEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = TrgtGrpEdit + Left = 33 + Height = 15 + Top = 31 + Width = 100 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Focal Group Code?' + ParentColor = False + end + object Label6: TLabel + AnchorSideTop.Control = LevelsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LevelsEdit + Left = 28 + Height = 15 + Top = 58 + Width = 105 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'No. of Score Levels?' + ParentColor = False + end + object RefGrpEdit: TEdit + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 141 + Height = 23 + Top = 0 + Width = 34 + Alignment = taRightJustify + Anchors = [akTop, akRight] + TabOrder = 0 + Text = 'RefGrpEdit' + end + object TrgtGrpEdit: TEdit + AnchorSideLeft.Control = RefGrpEdit + AnchorSideTop.Control = RefGrpEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = RefGrpEdit + AnchorSideRight.Side = asrBottom + Left = 141 + Height = 23 + Top = 27 + Width = 34 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 1 + Text = 'Edit1' + end + object LevelsEdit: TEdit + AnchorSideLeft.Control = RefGrpEdit + AnchorSideTop.Control = TrgtGrpEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 141 + Height = 23 + Top = 54 + Width = 34 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + OnExit = LevelsEditExit + TabOrder = 2 + Text = 'Edit1' + end + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox1 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 549 + Height = 138 + Top = 8 + Width = 191 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Right = 8 + Caption = 'Enter Bounds for Levels' + ClientHeight = 118 + ClientWidth = 187 + TabOrder = 2 + object Panel3: TPanel + AnchorSideTop.Control = GroupBox2 + Left = 8 + Height = 108 + Top = 2 + Width = 171 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 108 + ClientWidth = 171 + TabOrder = 0 + object Label8: TLabel + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = Panel3 + Left = 0 + Height = 15 + Top = 4 + Width = 31 + BorderSpacing.Top = 4 + Caption = 'Down' + ParentColor = False + end + object Label9: TLabel + AnchorSideTop.Control = Panel3 + Left = 106 + Height = 15 + Top = 4 + Width = 15 + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + Caption = 'Up' + ParentColor = False + end + object Label10: TLabel + AnchorSideTop.Control = Panel3 + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + Left = 123 + Height = 15 + Top = 4 + Width = 48 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Caption = 'Level' + ParentColor = False + end + object Label11: TLabel + AnchorSideTop.Control = LowBoundEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LowBoundEdit + Left = 51 + Height = 15 + Top = 62 + Width = 70 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Lower Bound' + ParentColor = False + end + object UpBoundlabel: TLabel + AnchorSideTop.Control = UpBoundEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = UpBoundEdit + Left = 48 + Height = 15 + Top = 89 + Width = 73 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Upper Bound:' + ParentColor = False + end + object LevelScroll: TScrollBar + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = LevelNoEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LevelNoEdit + Left = 0 + Height = 16 + Top = 28 + Width = 121 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Right = 8 + Min = 1 + PageSize = 0 + Position = 1 + TabOrder = 0 + OnScroll = LevelScrollScroll + end + object LevelNoEdit: TEdit + AnchorSideTop.Control = Label10 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + Left = 129 + Height = 23 + Top = 25 + Width = 42 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 6 + TabOrder = 1 + Text = 'LevelNoEdit' + end + object LowBoundEdit: TEdit + AnchorSideLeft.Control = LevelNoEdit + AnchorSideTop.Control = LevelNoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + Left = 129 + Height = 23 + Top = 58 + Width = 42 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 10 + OnExit = LowBoundEditExit + TabOrder = 2 + Text = 'Edit4' + end + object UpBoundEdit: TEdit + AnchorSideLeft.Control = LevelNoEdit + AnchorSideTop.Control = LowBoundEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + Left = 129 + Height = 23 + Top = 85 + Width = 42 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + OnExit = UpBoundEditExit + TabOrder = 3 + Text = 'Edit4' + end + end + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/difunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/difunit.pas new file mode 100644 index 000000000..455a1638a --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/difunit.pas @@ -0,0 +1,1043 @@ +unit DifUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, OutputUnit, MatrixLib, FunctionsLib, GraphLib, ContextHelpUnit; + +type + DynamicCharArray = array of char; + + { TDIFFrm } + + TDIFFrm = class(TForm) + Bevel1: TBevel; + GroupBox2: TGroupBox; + HelpBtn: TButton; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + ItemStatsChk: TCheckBox; + TestStatsChk: TCheckBox; + ItemCorrsChk: TCheckBox; + ItemTestChk: TCheckBox; + AlphaChk: TCheckBox; + MHChk: TCheckBox; + LogisticChk: TCheckBox; + CurvesChk: TCheckBox; + CountsChk: TCheckBox; + RefGrpEdit: TEdit; + TrgtGrpEdit: TEdit; + LevelsEdit: TEdit; + LevelNoEdit: TEdit; + LowBoundEdit: TEdit; + UpBoundEdit: TEdit; + GroupBox1: TGroupBox; + ItemInBtn: TBitBtn; + ItemOutBtn: TBitBtn; + AllBtn: TBitBtn; + GrpInBtn: TBitBtn; + GrpOutBtn: TBitBtn; + GroupVarEdit: TEdit; + Label1: TLabel; + Label10: TLabel; + Label11: TLabel; + UpBoundlabel: TLabel; + Label2: TLabel; + ItemsList: TListBox; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Label8: TLabel; + Label9: TLabel; + LevelScroll: TScrollBar; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure UpBoundEditExit(Sender: TObject); + procedure GrpInBtnClick(Sender: TObject); + procedure GrpOutBtnClick(Sender: TObject); + procedure ItemInBtnClick(Sender: TObject); + procedure ItemOutBtnClick(Sender: TObject); + procedure LevelScrollScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); + procedure LevelsEditExit(Sender: TObject); + procedure LowBoundEditExit(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + NoItems : integer; + nolevels : integer; + tmean, tvar, tsd : double; + ColNoSelected : IntDyneVec; + ColLabels, RowLabels : StrDyneVec; + Means, Variances, StdDevs : DblDyneVec; + CorMat : DblDyneMat; // correlations among items and total score + Data : IntDyneMat; //store item scores and total score + Ubounds : IntDyneVec; // upper and lower bounds of score groups + Lbounds : IntdyneVec; + Code : DynamicCharArray; // blank, A, B or C ETS codes + Level10OK : IntdyneMat; // check that each item category >= 10 + RMHRight : IntDyneMat; // no. right for items by score group in reference group + RMHWrong : IntDyneMat; // no. wrong for items by score group in reference group + FMHRight : IntDyneMat; // no. right for items by score group in focus group + FMHWrong : IntDyneMat; // no. wrong for items by score group in focus group + RScrGrpCnt : IntDyneMat; // total responses for score groups in reference group + FScrGrpCnt : IntDyneMat; // total responses for score groups in focus group + NT : IntDyneMat; // total right and wrong in each category of each item + Alpha : DblDyneVec; + AlphaNum : DblDyneVec; + AlphaDen : DblDyneVec; + MHDiff : DblDyneVec; + ExpA : DblDyneMat; + VarA : DblDyneMat; + SumA : DblDyneVec; + SumExpA : DblDyneVec; + SumVarA : DblDyneVec; + ChiSqr : DblDyneVec; + Prob : DblDyneVec; + SEMHDDif : DblDyneVec; + Aster : StrDyneVec; + C : DblDyneVec; + CodeRF : DynamicCharArray; + Tot : IntDyneVec; + procedure AlphaRel(Sender: TObject); + procedure ItemCorrs(Sender: TObject); + procedure ItemTestCorrs(Sender: TObject); + procedure ItemCurves(Sender: TObject); + + public + { public declarations } + end; + +var + DIFFrm: TDIFFrm; + +implementation + +uses + Math; + +{ TDIFFrm } + +procedure TDIFFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + ItemsList.Clear; + GroupVarEdit.Text := ''; + ItemInBtn.Enabled := true; + ItemOutBtn.Enabled := false; + AllBtn.Visible := true; + GrpInBtn.Enabled := true; + GrpOutBtn.Enabled := false; + ItemStatsChk.Checked := true; + TestStatsChk.Checked := false; + ItemCorrsChk.Checked := false; + ItemTestChk.Checked := false; + MHChk.Checked := true; + LogisticChk.Checked := false; + RefGrpEdit.Text := ''; + TrgtGrpEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + if NoVariables > 0 then LevelScroll.Max := NoVariables; + LevelNoEdit.Text := '1'; + LowBoundEdit.Text := '0'; + UpBoundEdit.Text := '2'; + //allocate space on heap + SetLength(ColLabels,NoVariables+1); + SetLength(RowLabels,NoVariables+1); + SetLength(Means,NoVariables); + SetLength(Variances,NoVariables); + SetLength(StdDevs,NoVariables); + SetLength(CorMat,NoVariables,NoVariables); + SetLength(Data,NoCases,NoVariables+3); //group, items, total, flag + SetLength(Lbounds,NoVariables); + SetLength(Ubounds,NoVariables); + SetLength(Tot,NoCases); + SetLength(ColNoSelected,NoVariables); +end; + +procedure TDIFFrm.ReturnBtnClick(Sender: TObject); +begin + ColNoSelected := nil; + C := nil; + SEMHDDif := nil; + Aster := nil; + Prob := nil; + ChiSqr := nil; + SumVarA := nil; + SumExpA := nil; + SumA := nil; + VarA := nil; + ExpA := nil; + CodeRF := nil; + MHDiff := nil; + AlphaDen := nil; + AlphaNum := nil; + Alpha := nil; + NT := nil; + Level10OK := nil; + Code := nil; + FScrGrpCnt := nil; + RScrGrpCnt := nil; + FMHWrong := nil; + FMHRight := nil; + RMHWrong := nil; + RMHRight := nil; + Tot := nil; + Ubounds := nil; + Lbounds := nil; + Data := nil; + CorMat := nil; + StdDevs := nil; + Variances := nil; + Means := nil; + RowLabels := nil; + ColLabels := nil; + DIFfrm.Hide; +end; + +procedure TDIFFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinWidth := GroupVarEdit.Width; + Panel1.Constraints.MinHeight := GroupBox1.Height - Label1.Height; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TDIFFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TDIFFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TDIFFrm.GrpInBtnClick(Sender: TObject); +VAR index : integer; +begin + if VarList.ItemIndex < 0 then + begin + GrpInBtn.Enabled := false; + exit; + end; + index := VarList.ItemIndex; + GroupVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + GrpInBtn.Enabled := false; + GrpOutBtn.Enabled := true; +end; + +procedure TDIFFrm.GrpOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(GroupVarEdit.Text); + GroupVarEdit.Text := ''; + GrpInBtn.Enabled := true; + GrpOutBtn.Enabled := false; +end; + +procedure TDIFFrm.ItemInBtnClick(Sender: TObject); +VAR i, index : integer; +begin + if VarList.ItemIndex < 0 then + begin + ItemInBtn.Enabled := false; + exit; + end; + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + ItemsList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + ItemOutBtn.Enabled := true; +end; + +procedure TDIFFrm.ItemOutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := ItemsList.ItemIndex; + if index < 0 then + begin + ItemOutBtn.Enabled := false; + exit; + end; + VarList.Items.Add(ItemsList.Items.Strings[index]); + ItemsList.Items.Delete(index); + ItemInBtn.Enabled := true; +end; + +procedure TDIFFrm.LevelScrollScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); +var + scrlpos : integer; + level : integer; +begin + level := StrToInt(LevelNoEdit.Text); + scrlpos := LevelScroll.Position; + if ((scrlpos > level) and (level <= StrToInt(LevelsEdit.Text))) then + begin + LevelNoEdit.Text := IntToStr(scrlpos); + LowBoundEdit.SetFocus; + exit; + end; + if scrlpos < level then + begin + level := scrlpos; + if level > 0 then + begin + LevelNoEdit.Text := IntToStr(level); + LowBoundEdit.Text := IntToStr(Lbounds[level-1]); + UpBoundEdit.Text := IntToStr(Ubounds[level-1]); + end; + LowBoundEdit.SetFocus; + end; +end; + +procedure TDIFFrm.LevelsEditExit(Sender: TObject); +begin + LevelScroll.Max := StrToInt(LevelsEdit.Text); + LowBoundEdit.SetFocus; +end; + +procedure TDIFFrm.LowBoundEditExit(Sender: TObject); +VAR i : integer; +begin + i := StrToInt(LevelNoEdit.Text); + Lbounds[i-1] := StrToInt(LowBoundEdit.Text); + UpBoundEdit.SetFocus; +end; + +procedure TDIFFrm.ComputeBtnClick(Sender: TObject); +Label LoopStart; +var + i, j, k : integer; + itm : integer; + grpvar : integer; + subjgrp : integer; + value : integer; + subjscore : integer; + sum : integer; + cellstring : string; + title : string; + nsize : array [1..2] of integer; + Rtm, Wtm : double; + TotPurge : integer; + LoopIt : integer; + RItem: integer; +begin + LoopIt := 0; + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Mantel-Haenszel DIF Analysis adapted by Bill Miller from'); + OutputFrm.RichEdit.Lines.Add('EZDIF written by Niels G. Waller'); + OutputFrm.RichEdit.Lines.Add(''); + + NoItems := ItemsList.Items.Count; + for k := 1 to 2 do nsize[k] := 0; + + // get items to analyze and their labels + for i := 1 to NoItems do // items to analyze + begin + for j := 1 to NoVariables do // variables in grid + begin + cellstring := OS3MainFrm.DataGrid.Cells[j,0]; + if cellstring = ItemsList.Items.Strings[i-1] then + begin // matched - save info + ColNoSelected[i-1] := j; + ColLabels[i-1] := cellstring; + RowLabels[i-1] := cellstring; + end; // end match + end; // next j + end; // next i + ColLabels[NoItems] := 'TOTAL'; + RowLabels[NoItems] := 'TOTAL'; + + // get the variable number of the grouping code + grpvar := 0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = GroupVarEdit.Text then grpvar := i; + end; + if grpvar = 0 then + begin + ShowMessage('Error - No group variable found.'); + exit; + end; + + // get number of test score levels + nolevels := StrToInt(LevelsEdit.Text); + + // read data (score group and items) + for i := 1 to NoCases do + begin + subjscore := 0; + value := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[grpvar,i]))); + subjgrp := 0; + if value = StrToInt(RefGrpEdit.Text) then subjgrp := 1; // reference grp + if value = StrToInt(TrgtGrpEdit.Text) then subjgrp := 2; // target group + if subjgrp = 0 then + begin + ShowMessage('Error - Bad group code for a subject.'); + exit; + end; + Data[i-1,0] := subjgrp; + nsize[subjgrp] := nsize[subjgrp] + 1; + for j := 1 to NoItems do + begin + itm := ColNoSelected[j-1]; + value := Round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[itm,i]))); + if value = 1 then subjscore := subjscore + 1; + Data[i-1,j] := value; + end; + Tot[i-1] := subjscore; + end; + + // obtain item means, variances, standard deviations for total subjects + for i := 0 to NoItems-1 do + begin + Means[i] := 0.0; + Variances[i] := 0.0; + StdDevs[i] := 0.0; + for j := 0 to NoCases - 1 do + begin + Means[i] := Means[i] + Data[j,i+1]; + Variances[i] := Variances[i] + (Data[j,i+1] * Data[j,i+1]); + end; + Variances[i] := (Variances[i] - (Means[i] * Means[i] / NoCases)) / (NoCases - 1); + if Variances[i] <= 0 then + begin + cellstring := format('Item %d has zero variance. Unselect the item.', + [i+1]); + ShowMessage(cellstring); + ResetBtnClick(Self); + exit; + end; + StdDevs[i] := sqrt(Variances[i]); + Means[i] := Means[i] / NoCases; + end; + + // obtain total score mean, variance and stddev + tmean := 0.0; + tvar := 0.0; + tsd := 0.0; + for i := 0 to NoCases - 1 do + begin + tmean := tmean + Tot[i]; + tvar := tvar + (Tot[i] * Tot[i]); + end; + tvar := (tvar - (tmean * tmean / NoCases)) / (NoCases - 1); + tsd := sqrt(tvar); + tmean := tmean / NoCases; + + // print descriptives if checked + if ItemStatsChk.Checked then + begin + title := 'Total Means'; + DynVectorPrint(Means,NoItems,title,ColLabels,NoCases); + title := 'Total Variances'; + DynVectorPrint(Variances,NoItems,title,ColLabels,NoCases); + title := 'Total Standard Deviations'; + DynVectorPrint(StdDevs,NoItems,title,ColLabels,NoCases); + end; + + // Show total test score statistics if checked + if TestStatsChk.Checked then + begin + cellstring := format('Total Score: Mean = %10.3f, Variance = %10.3f, Std.Dev. = %10.3f', + [tmean, tvar, tsd]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + cellstring := format('Reference group size = %d, Focus group size = %d', + [nsize[1],nsize[2]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // get Cronbach alpha for total group if checked + if AlphaChk.Checked then AlphaRel(Self); + + // Get item intercorrelations for total group if checked + if ItemCorrsChk.Checked then + begin + ItemCorrs(Self); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + // Get item-total score correlations for total group if checked + if ItemTestChk.Checked then + begin + ItemTestCorrs(Self); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + // Show upper and lower bounds for score group bins + OutputFrm.RichEdit.Lines.Add('Conditioning Levels'); + OutputFrm.RichEdit.Lines.Add('Lower Upper'); + for i := 0 to nolevels-1 do + begin + cellstring := format('%5d %5d',[Lbounds[i],Ubounds[i]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.ShowModal; + + // check for zero variance in each group + for k := 1 to 2 do // group + begin + for i := 0 to NoItems-1 do // item + begin + sum := 0; + for j := 0 to NoCases-1 do // subject + begin + if Data[j,0] = k then // group match ? + begin + sum := sum + Data[j,i+1]; + end; + end; + end; + if ((sum = 0) or (sum = NoVariables)) then + begin + cellstring := format('Item %d in group %d has zero variance.', + [i+1,k]); + ShowMessage(cellstring); + exit; + end; + end; + + // Get count of no. right and wrong for each item in each group + SetLength(RMHRight,nolevels,NoItems); + SetLength(RMHWrong,nolevels,NoItems); + SetLength(FMHRight,nolevels,NoItems); + SetLength(FMHWrong,nolevels,NoItems); + SetLength(RScrGrpCnt,nolevels,NoItems); + SetLength(FScrGrpCnt,nolevels,NoItems); + SetLength(Code,NoItems); + SetLength(Level10OK,nolevels,NoItems); + SetLength(NT,nolevels,NoItems); + SetLength(Alpha,NoItems); + SetLength(AlphaNum,NoItems); + SetLength(AlphaDen,NoItems); + SetLength(MHDiff,NoItems); + SetLength(CodeRF,NoItems); + SetLength(ExpA,nolevels,NoItems); + SetLength(VarA,nolevels,NoItems); + SetLength(SumA,NoItems); + SetLength(SumExpA,NoItems); + SetLength(SumVarA,NoItems); + SetLength(ChiSqr,NoItems); + SetLength(Prob,NoItems); + SetLength(Aster,NoItems); + SetLength(SEMHDDif,NoItems); + SetLength(C,NoItems); + +LoopStart: + // clear arrays + for j := 0 to NoItems-1 do + begin + for k := 0 to nolevels-1 do + begin + RMHRight[k,j] := 0; + RMHWrong[k,j] := 0; + RScrGrpCnt[k,j] := 0; + FMHRight[k,j] := 0; + FMHWrong[k,j] := 0; + FScrGrpCnt[k,j] := 0; + Level10OK[k,j] := 1; + NT[k,j] := 0; + ExpA[k,j] := 0.0; + VarA[k,j] := 0.0; + end; + Alpha[j] := 0.0; + AlphaNum[j] := 0.0; + AlphaDen[j] := 0.0; + MHDiff[j] := 0.0; + CodeRF[j] := ' '; + Prob[j] := 0.0; + end; + + LoopIt := LoopIt + 1; + OutputFrm.RichEdit.Clear; + cellstring := format('COMPUTING M-H CHI-SQUARE, PASS # %d',[LoopIt]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for k := 0 to nolevels-1 do + begin + for i := 0 to NoCases-1 do + begin + subjgrp := Data[i,0]; + for j := 0 to NoItems-1 do + begin + RItem := 0; + value := Data[i,j+1]; + if ((LoopIt = 2) and (Code[j] = 'C')) then RItem := value; + if value = 1 then + begin + if ((Tot[i]+RItem >= Lbounds[k]) and + (Tot[i]+RItem <= Ubounds[k])) then + begin + if subjgrp = 1 then + begin + RMHRight[k,j] := RMHRight[k,j] + 1; + RScrGrpCnt[k,j] := RScrGrpCnt[k,j] + 1; + end; // if reference group + if subjgrp = 2 then + begin + FMHRight[k,j] := FMHRight[k,j] + 1; + FScrGrpCnt[k,j] := FScrGrpCnt[k,j] + 1; + end; // if focus group + end; // end if () and () + end; // value = 1 + if value = 0 then + begin + if ((Tot[i]+RItem >= Lbounds[k]) and + (Tot[i]+RItem <= Ubounds[k])) then + begin + if subjgrp = 1 then + begin + RMHWrong[k,j] := RMHWrong[k,j] + 1; + RScrGrpCnt[k,j] := RScrGrpCnt[k,j] + 1; + end; + if subjgrp = 2 then + begin + FMHWrong[k,j] := FMHWrong[k,j] + 1; + FScrGrpCnt[k,j] := FScrGrpCnt[k,j] + 1; + end; + end; + end; // if value = 0 + end; // next j + end; // next i + end; // next k + for j := 0 to NoItems-1 do Code[j] := 'Z'; // clean out ETS code + + // print score group counts for Reference and focus subjects + if CountsChk.Checked then + begin + for i := 0 to nolevels-1 do + RowLabels[i] := format('%3d-%3d',[Lbounds[i],Ubounds[i]]); + DynIntMatPrint(RScrGrpCnt,nolevels,NoItems,'Score Level Counts by Item',RowLabels,ColLabels, + 'Cases in Reference Group'); + DynIntMatPrint(FScrGrpCnt,nolevels,NoItems,'Score Level Counts by Item',RowLabels,ColLabels, + 'Cases in Focus Group'); + end; + + // Plot Item curves if checked + if ((CurvesChk.Checked) and (LoopIt = 1)) then ItemCurves(Self); + + // check for minimum of 10 per category in each item + // compute NT + for j := 0 to NoItems-1 do + begin + for k := 0 to nolevels-1 do + begin + if ((RScrGrpCnt[k,j] < 10) or (FScrGrpCnt[k,j] < 10)) then + Level10OK[k,j] := 0 // insufficient n + else Level10OK[k,j] := 1; // 10 or more - OK + NT[k,j] := RScrGrpCnt[k,j] + FScrGrpCnt[k,j]; + end; + end; + + for k := 0 to nolevels-1 do + begin + if Level10OK[k,0] = 0 then + begin + cellstring := format('Insufficient data found in level: %d - %d', + [Lbounds[k],Ubounds[k]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + end; + + // compute alpha + for j := 0 to NoItems - 1 do + begin + for k := 0 to nolevels-1 do + begin + if Level10OK[k,j] = 1 then + begin + AlphaNum[j] := AlphaNum[j] + (RMHRight[k,j] * FMHWrong[k,j]) / NT[k,j]; + AlphaDen[j] := AlphaDen[j] + (RMHWrong[k,j] * FMHRight[k,j]) / NT[k,j]; + end; + end; + end; + + for j := 0 to NoItems-1 do + begin + if AlphaDen[j] = 0.0 then + begin + cellstring := format('Window too small at item %d level %d', + [j+1,k+1]); + ShowMessage(cellstring); + exit; + end + else begin + Alpha[j] := AlphaNum[j] / AlphaDen[j]; + MHDiff[j] := -2.35 * ln(Alpha[j]); + end; + end; + + // compute expected values + for j := 0 to NoItems-1 do + begin + for k := 0 to nolevels-1 do + begin + if Level10OK[k,j] = 1 then + begin + ExpA[k,j] := (RScrGrpCnt[k,j] * (RMHRight[k,j] + FMHRight[k,j] )) / NT[k,j]; + end; + end; + end; + + // compute variances + for j := 0 to NoItems-1 do + begin + for k := 0 to nolevels-1 do + begin + if Level10OK[k,j] = 1 then + begin + Rtm := RMHRight[k,j] + FMHRight[k,j]; + Wtm := RMHWrong[k,j] + FMHWrong[k,j]; + VarA[k,j] := (RScrGrpCnt[k,j] * FScrGrpCnt[k,j] * Rtm * Wtm) / + ( NT[k,j] * NT[k,j] * (NT[k,j]-1) ); + end; + end; + end; + + // compute chi-squares + for j := 0 to NoItems-1 do + begin + SumA[j] := 0.0; + SumExpA[j] := 0.0; + SumVarA[j] := 0.0; + for k := 0 to nolevels-1 do + begin + if Level10OK[k,j] = 1 then + begin + SumA[j] := SumA[j] + RMHRight[k,j]; + SumExpA[j] := SumExpA[j] + ExpA[k,j]; + SumVarA[j] := SumVarA[j] + VarA[k,j]; + end; + end; + end; + + for j := 0 to NoItems-1 do + begin + ChiSqr[j] := (sqr((Abs(SumA[j] - SumExpA[j]) - 0.5))) / SumVarA[j]; + Prob[j] := 1.0 - chisquaredprob(ChiSqr[j],1); + if Prob[j] > 0.05 then Aster[j] := ''; + if Prob[j] <= 0.05 then Aster[j] := '*'; + if Prob[j] <= 0.01 then Aster[j] := '**'; + if Prob[j] <= 0.005 then Aster[j] := '***'; + end; + + // compute std. errors + for j := 0 to NoItems-1 do + begin + C[j] := 0.0; + for k := 0 to nolevels-1 do + begin + if Level10OK[k,j] = 1 then + C[j] := C[j] + ((RMHRight[k,j] * FMHWrong[k,j]) / NT[k,j]); + end; + end; + + for j := 0 to NoItems - 1 do + begin + SEMHDDif[j] := 0.0; + for k := 0 to nolevels-1 do + begin + if Level10OK[k,j] = 1 then + begin + SEMHDDif[j] := SEMHDDif[j] + ( (RMHRight[k,j] * FMHWrong[k,j] ) + + ( Alpha[j] * RMHWrong[k,j] * FMHRight[k,j])) * + ( RMHRight[k,j] + FMHWrong[k,j] + Alpha[j] * + ( RMHWrong[k,j] + FMHRight[k,j] )) / ( 2.0 * NT[k,j] * NT[k,j]); + end; + end; + end; + + for j := 0 to NoItems-1 do + SEMHDDif[j] := (2.35 / C[j]) * sqrt(SEMHDDif[j]); + + // code results with ETS codes + for j := 0 to NoItems-1 do + begin + if ( (abs(MHDiff[j]) > 1.5) and ((abs(MHDiff[j]) - (1.96 * SEMHDDif[j]) + > 1.0))) then Code[j] := 'C'; + if ((abs(MHDiff[j]) - (1.96 * SEMHDDif[j]) <= 0.0) or + (abs(MHDiff[j]) <= 1.0)) then code[j] := 'A'; + if ((code[j] <> 'A') and (code[j] <> 'C')) then code[j] := 'B'; + end; + + // purge + TotPurge := 0; + for j := 0 to NoItems-1 do + begin + if (code[j] = 'C') then + begin + TotPurge := TotPurge + 1; + for i := 0 to NoCases - 1 do Tot[i] := Tot[i] - Data[i,j+1]; + if Alpha[j] > 1.0 then CodeRF[j] := 'R'; + if Alpha[j] < 1.0 then CodeRF[j] := 'F'; + end; + end; + + // show results +// OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add( + 'CODES ITEM SIG. ALPHA CHI2 P-VALUE MH D-DIF S.E. MH D-DIF'); + for j := 0 to noitems-1 do + begin + cellstring := format('%1s %1s %4d %3s %6.3f %7.3f %6.3f %6.3f %6.3f', + [code[j],CodeRF[j], j+1, Aster[j],Alpha[j],ChiSqr[j],Prob[j],MHDiff[j], + SEMHDDif[j]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + OutputFrm.RichEdit.Lines.Add(''); + if LoopIt = 1 then + begin + cellstring := format('No. of items purged in pass 1 = %d',[TotPurge]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add('Item Numbers:'); + for j := 0 to NoItems-1 do + begin + if Code[j] = 'C' then + begin + cellstring := format('%d',[j+1]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + end; + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.ShowModal; + if LoopIt < 2 then goto LoopStart; +end; + +procedure TDIFFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TDIFFrm.UpBoundEditExit(Sender: TObject); +VAR i : integer; +begin + i := StrToInt(LevelNoEdit.Text); + Ubounds[i-1] := StrToInt(UpBoundEdit.Text); + if i = StrToInt(LevelsEdit.Text) then + begin + ComputeBtn.SetFocus; + exit; + end; + LowBoundEdit.Text := IntToStr(Ubounds[i-1] + 1); + LowBoundEdit.SetFocus; +end; + +procedure TDIFFrm.AllBtnClick(Sender: TObject); +VAR i : integer; +begin + if VarList.Items.Count < 1 then exit; + for i := 0 to VarList.Items.Count - 1 do + ItemsList.Items.Add(VarList.Items.Strings[i]); + VarList.Clear; + ItemInBtn.Enabled := false; + ItemOutBtn.Enabled := true; +end; + +procedure TDIFfrm.AlphaRel(Sender: TObject); +var + i : integer; + Alpha1, SEMeas : double; + outline : string; +begin + OutPutFrm.RichEdit.Clear; + OutPutFrm.RichEdit.Lines.Add(''); + Alpha1 := 0.0; + + for i := 0 to NoItems-1 do + Alpha1 := Alpha1 + variances[i]; // sum of item variances + Alpha1 := Alpha1 / tvar; + Alpha1 := 1.0 - Alpha1; + Alpha1 := (NoItems / (NoItems - 1.0)) * Alpha1; + SEMeas := tsd * sqrt(1.0 - Alpha1); + outline := format('Alpha Reliability Estimate for Test = %6.4f S.E. of Measurement = %8.3f', + [Alpha1,SEMeas]); + OutPutFrm.RichEdit.Lines.Add(outline); +// OutPutFrm.ShowModal; +end; + +procedure TDIFfrm.ItemCorrs(Sender: TObject); +var + i, j, k : integer; + title : string; +begin + // cross-products + for i := 0 to NoItems-1 do + for j := 0 to NoItems-1 do + for k := 0 to NoCases-1 do + CorMat[i,j] := CorMat[i,j] + (Data[k,i+1] * Data[k,j+1]); + // covariances + for i := 0 to NoItems-1 do + for j := 0 to NoItems-1 do + CorMat[i,j] := (CorMat[i,j] - (NoCases * Means[i] * Means[j])) / + (NoCases-1); + + // correlations + for i := 0 to NoItems-1 do + for j := 0 to NoItems-1 do + CorMat[i,j] := CorMat[i,j] / (StdDevs[i] * StdDevs[j]); + + // show results + OutPutFrm.RichEdit.Clear; + title := 'Correlations Among Items'; + MAT_PRINT(CorMat,NoItems,NoItems,title,RowLabels,ColLabels,NoCases); +end; + +procedure TDIFfrm.ItemTestCorrs(Sender: TObject); +var + i, j : integer; + Cors : DblDyneVec; + title : string; +begin + SetLength(Cors,NoItems); + // cross-products + for i := 0 to NoItems-1 do + for j := 0 to NoCases-1 do + Cors[i] := Cors[i] + (Data[j,i+1] * Tot[j]); + // covariances + for i := 0 to NoItems-1 do + Cors[i] := (Cors[i] - (NoCases * Means[i] * tmean)) / (NoCases-1); + // correlations + for i := 0 to NoItems-1 do + Cors[i] := Cors[i] / (StdDevs[i] * tsd); + // show results +// OutPutFrm.RichEdit.Clear; + title := 'Item-Total Correlations'; + DynVectorPrint(Cors,NoItems,title,ColLabels,NoCases); + // release memory + Cors := nil; +end; + +procedure TDIFfrm.ItemCurves(Sender: TObject); +var + i, ii, j : integer; + XPlotPts : DblDyneMat; + YPlotPts : DblDyneMat; + LabelStr, outline, xTitle, yTitle : string; + max : integer; +begin + SetLength(YPlotPts,2,nolevels); + SetLength(XPlotPts,1,nolevels); + + // get maximum no. of scores in either groups bins + for i := 0 to NoItems-1 do + begin + max := 0; + for j := 0 to nolevels-1 do + begin + if RMHRight[j,i] > max then max := RMHRight[j,i]; + if FMHRight[j,i] > max then max := FMHRight[j,i]; + end; + + // Plot reference group in blue, focus group in red + for ii := 1 to 2 do // possible group curves + begin + for j := 0 to nolevels-1 do //get points to plot + begin + XPlotPts[0,j] := Lbounds[j]; + if ii = 1 then YPlotPts[ii-1,j] := RMHRight[j,i]; + if ii = 2 then YPlotPts[ii-1,j] := FMHRight[j,i]; + end; + end; // next group + + // Plot the points + GraphFrm.BackColor := clWhite; + GraphFrm.ShowLeftWall := true; + GraphFrm.ShowRightWall := true; + GraphFrm.ShowBottomWall := true; + GraphFrm.ShowBackWall := true; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlue; + GraphFrm.FloorColor := clBlue; + outline := format('Blue = Reference, Red = Focus for item %d',[i+1]); + GraphFrm.Heading := outline; + xTitle := 'Lower bounds of levels'; + GraphFrm.XTitle := xTitle; + yTitle := 'Frequencies'; + GraphFrm.YTitle := yTitle; + GraphFrm.nosets := 2; + GraphFrm.nbars := nolevels; + GraphFrm.barwideprop := 0.5; + GraphFrm.miny := 0.0; + GraphFrm.maxy := max; + GraphFrm.AutoScaled := false; + GraphFrm.GraphType := 5; // 2d line charts + GraphFrm.PtLabels := false; + for ii := 1 to 2 do + begin + if ii = 1 then LabelStr := 'Reference'; + if ii = 2 then LabelStr := 'Focus'; + GraphFrm.SetLabels[ii] := LabelStr; + end; + GraphFrm.Ypoints := YPlotPts; + GraphFrm.Xpoints := XPlotPts; + GraphFrm.ShowModal; + end; // next item + + XPlotPts := nil; + YPlotPts := nil; +end; + +initialization + {$I difunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/gradebookunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/gradebookunit.lfm new file mode 100644 index 000000000..55745fece --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/gradebookunit.lfm @@ -0,0 +1,279 @@ +object GradebookFrm: TGradebookFrm + Left = 410 + Height = 541 + Top = 275 + Width = 956 + Caption = 'Gradebook' + ClientHeight = 521 + ClientWidth = 956 + Menu = MainMenu1 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Grid: TStringGrid + Left = 304 + Height = 521 + Top = 0 + Width = 652 + Align = alClient + ColCount = 58 + FixedCols = 0 + MouseWheelOption = mwGrid + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goTabs, goThumbTracking, goSmoothScroll] + RowCount = 41 + TabOrder = 0 + OnExit = GridExit + end + object Panel1: TPanel + Left = 0 + Height = 521 + Top = 0 + Width = 299 + Align = alLeft + Caption = 'Panel1' + ClientHeight = 521 + ClientWidth = 299 + TabOrder = 1 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel1 + Left = 26 + Height = 24 + Top = 9 + Width = 246 + BorderSpacing.Top = 8 + Caption = 'YOUR GRADEBOOK FOR:' + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -21 + Font.Name = 'Times New Roman' + Font.Pitch = fpVariable + Font.Quality = fqDraft + Font.Style = [fsBold, fsItalic] + ParentColor = False + ParentFont = False + end + object Label2: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = FileNameEdit + AnchorSideTop.Side = asrCenter + Left = 9 + Height = 15 + Top = 45 + Width = 21 + BorderSpacing.Left = 8 + Caption = 'File:' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = FileNameEdit + AnchorSideTop.Side = asrBottom + Left = 9 + Height = 15 + Top = 72 + Width = 199 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Directory (click folder icon to change)' + ParentColor = False + end + object FileNameEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 38 + Height = 23 + Top = 41 + Width = 252 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 0 + Text = 'FileNameEdit' + end + object DirectoryEdit1: TDirectoryEdit + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 9 + Height = 23 + Top = 89 + Width = 284 + ShowHidden = False + ButtonWidth = 23 + NumGlyphs = 1 + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + MaxLength = 0 + TabOrder = 1 + OnChange = DirectoryEdit1Change + end + object FileListBox1: TFileListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = DirectoryEdit1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ResetBtn + Left = 9 + Height = 334 + Top = 116 + Width = 281 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 15 + TabOrder = 2 + end + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideBottom.Control = ExitBtn + Left = 9 + Height = 25 + Top = 458 + Width = 77 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 4 + Caption = 'Start New' + TabOrder = 3 + end + object ExitBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideRight.Control = ResetBtn + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 9 + Height = 25 + Top = 487 + Width = 77 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 8 + Caption = 'Exit' + ModalResult = 1 + OnClick = ExitBtnClick + TabOrder = 4 + end + object RadioGroup1: TRadioGroup + AnchorSideLeft.Control = ExitBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 102 + Height = 51 + Top = 461 + Width = 157 + Anchors = [akLeft, akBottom] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Bottom = 8 + Caption = 'Name Protection:' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 8 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 31 + ClientWidth = 153 + Columns = 2 + ItemIndex = 1 + Items.Strings = ( + 'Turn ON' + 'Turn OFF' + ) + OnClick = RadioGroup1Click + TabOrder = 5 + end + end + object Splitter1: TSplitter + Left = 299 + Height = 521 + Top = 0 + Width = 5 + end + object MainMenu1: TMainMenu + left = 592 + top = 80 + object FilesMenu: TMenuItem + Caption = 'Files' + object NewGBMnu: TMenuItem + Caption = 'New Grade Book' + OnClick = NewGBMnuClick + end + object OpenGBMnu: TMenuItem + Caption = 'Open Existing Grade Book' + OnClick = OpenGBMnuClick + end + object SaveGBMnu: TMenuItem + Caption = 'Save Grade Book' + OnClick = SaveGBMnuClick + end + object ExitMnu: TMenuItem + Caption = 'Exit' + OnClick = ExitMnuClick + end + end + object EditMnu: TMenuItem + Caption = 'Edit' + object DelRowMnu: TMenuItem + Caption = 'Delete Current Row' + OnClick = DelRowMnuClick + end + end + object ComputeMenu: TMenuItem + Caption = 'Compute' + object TestAnalMnu: TMenuItem + Caption = 'Analyze a Test' + OnClick = TestAnalMnuClick + end + object CompScrMnu: TMenuItem + Caption = 'Calc. Composite Score' + OnClick = CompScrMnuClick + end + end + object ReportsMenu: TMenuItem + Caption = 'Reports' + object StudRptsMnu: TMenuItem + Caption = 'Individual Student Reports' + OnClick = StudRptsMnuClick + end + object ClassRptMnu: TMenuItem + Caption = 'Class Report' + OnClick = ClassRptMnuClick + end + end + object HelpMenu: TMenuItem + Caption = 'Help' + Visible = False + end + end + object SaveDialog1: TSaveDialog + left = 472 + top = 144 + end + object OpenDialog1: TOpenDialog + left = 472 + top = 80 + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/gradebookunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/gradebookunit.pas new file mode 100644 index 000000000..404470f5a --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/gradebookunit.pas @@ -0,0 +1,906 @@ +unit GradeBookUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + Menus, StdCtrls, EditBtn, FileCtrl, ComCtrls, Grids, ExtCtrls, + Globals, OutputUnit, GraphLib, GradingUnit; + + Type + TestRcd = Record + TestNo : integer; + NoItems : integer; + Mean, Variance, StdDev : double; + KR21Rel : double; + Weight : double; + end; + + Type DblDyneMat = array of array of double; + Type DblDyneVec = array of double; + +type + + { TGradebookFrm } + + TGradebookFrm = class(TForm) + ExitBtn: TButton; + Label3: TLabel; + ExitMnu: TMenuItem; + CompScrMnu: TMenuItem; + ClassRptMnu: TMenuItem; + EditMnu: TMenuItem; + DelRowMnu: TMenuItem; + OpenDialog1: TOpenDialog; + Panel1: TPanel; + SaveDialog1: TSaveDialog; + Splitter1: TSplitter; + StudRptsMnu: TMenuItem; + TestAnalMnu: TMenuItem; + SaveGBMnu: TMenuItem; + OpenGBMnu: TMenuItem; + NewGBMnu: TMenuItem; + RadioGroup1: TRadioGroup; + ResetBtn: TButton; + DirectoryEdit1: TDirectoryEdit; + FileListBox1: TFileListBox; + FileNameEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + MainMenu1: TMainMenu; + FilesMenu: TMenuItem; + ComputeMenu: TMenuItem; + HelpMenu: TMenuItem; + ReportsMenu: TMenuItem; + Grid: TStringGrid; + procedure ClassRptMnuClick(Sender: TObject); + procedure CompScrMnuClick(Sender: TObject); + procedure DelRowMnuClick(Sender: TObject); + procedure DirectoryEdit1Change(Sender: TObject); + procedure ExitBtnClick(Sender: TObject); + procedure ExitMnuClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure GridExit(Sender: TObject); + procedure NewGBMnuClick(Sender: TObject); + procedure OpenGBMnuClick(Sender: TObject); + procedure RadioGroup1Click(Sender: TObject); + procedure SaveGBMnuClick(Sender: TObject); + procedure StudRptsMnuClick(Sender: TObject); + procedure TestAnalMnuClick(Sender: TObject); + + private + { private declarations } + TestNo, GridCol, GridRow, NoTests : integer; + + public + { public declarations } + nints, tno, NoStudents, nitems : integer; + freq : array[0..50] of double; + scores : array[0..50] of double; + sortedraw : DblDyneVec; + pcntiles : DblDyneMat; + tscores : DblDyneVec; + zscores : DblDyneVec; + pcntilerank : array[0..50] of double; + + end; + +var + GradebookFrm: TGradebookFrm; + +implementation + +{ TGradebookFrm } + +procedure TGradebookFrm.ExitBtnClick(Sender: TObject); +var response : string ; +begin + response := InputBox('SAVE','Save gradebook (Y or N)?','N'); + if response = 'Y' then SaveGBMnuClick(Self); + Close; +end; + +procedure TGradebookFrm.ExitMnuClick(Sender: TObject); +var response : string ; +begin + response := InputBox('SAVE','Save gradebook (Y or N)?','N'); + if response = 'Y' then SaveGBMnuClick(Self); + Close; +end; + +procedure TGradebookFrm.DirectoryEdit1Change(Sender: TObject); +begin + //DirectoryEdit1.Directory := GetCurrentDir; + FileListBox1.Directory := DirectoryEdit1.Directory; +end; + +procedure TGradebookFrm.DelRowMnuClick(Sender: TObject); +VAR + row, i, j : integer; +begin + row := Grid.Row; + for i := 0 to 57 do Grid.Cells[i,row] := ''; + if Grid.Cells[0,row+1] <> '' then + begin + for i := row + 1 to NoStudents do + begin + for j := 0 to 57 do Grid.Cells[j,i-1] := Grid.Cells[j,i]; + end; + for j := 0 to 57 do Grid.Cells[j,NoStudents] := ''; + NoStudents := NoStudents - 1; + end; +end; + +procedure TGradebookFrm.CompScrMnuClick(Sender: TObject); +var + i, j, k, NoVars, count, col : integer; + DataMat : array[1..50,1..10] of double; + Rmat, RelMat : array[1..10,1..10] of double; + Weights, Reliabilities, VectProd, means, variances, stddevs : array[1..10] of double; + X, Y, CompRel, numerator, denominator: double; + outline, cellstring : string; + title : string; + RowLabels : array[1..10] of string; + response : string; + nomiss : integer; + found : boolean; + +begin + OutputFrm.RichEdit.Clear; + NoVars := 0; + // get number of tests + for i := 1 to 10 do + begin + tno := i * 5 - 5; + col := tno + 3; // column of raw scores for test number + found := false; + for j := 1 to NoStudents do + begin + if Grid.Cells[col,j] <> '' then found := true; + end; + if found then + begin + NoVars := NoVars + 1; + RowLabels[NoVars] := 'Test ' + IntToStr(NoVars); + end; + end; + count := NoStudents; + + // get data + for i := 1 to NoVars do + begin + nomiss := 0; + tno := i * 5 - 5; + col := tno + 3; // column of raw scores for test number + for j := 1 to NoStudents do + begin + if Grid.Cells[col,j] <> '' then + DataMat[j,i] := StrToFloat(Grid.Cells[col,j]) + else nomiss := nomiss + 1; + end; + if nomiss >= NoStudents then NoVars := NoVars - 1; + end; + + OutputFrm.RichEdit.Lines.Add('Composite Test Reliability'); + OutputFrm.RichEdit.Lines.Add(''); + outline := 'File Analyzed: ' + FileNameEdit.Text; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + // get correlation matrix + for i := 1 to NoVars do + begin + means[i] := 0.0; + variances[i] := 0.0; + for j := 1 to NoVars do Rmat[i,j] := 0.0; + end; + + for i := 1 to NoStudents do // get cross-products matrix + begin + for j := 1 to NoVars do + begin + X := DataMat[i,j]; + means[j] := means[j] + X; + variances[j] := variances[j] + (X * X); + for k := 1 to NoVars do + begin + Y := DataMat[i,k]; + Rmat[j,k] := Rmat[j,k] + (X * Y); + end; + end; + end; + + for j := 1 to NoVars do // calculate variances and standard dev.s + begin + variances[j] := variances[j] - (means[j] * means[j] / NoStudents); + variances[j] := variances[j] / (NoStudents - 1.0); + if variances[j] <= 0.0 then + begin + ShowMessage('No variance found in test '+ IntToStr(j)); + exit; + end + else stddevs[j] := sqrt(variances[j]); + end; + + for j := 1 to NoVars do // get variance-covariance matrix + begin + for k := 1 to NoVars do + begin + Rmat[j,k] := Rmat[j,k] - (means[j] * means[k] / NoStudents); + Rmat[j,k] := Rmat[j,k] / (NoStudents - 1.0); + end; + end; + + for j := 1 to NoVars do // get correlation matrix + for k := 1 to NoVars do Rmat[j,k] := Rmat[j,k] / (stddevs[j] * stddevs[k]); + + for j := 1 to NoVars do means[j] := means[j] / NoStudents; + + OutputFrm.RichEdit.Lines.Add(''); + title := 'Correlations Among Tests'; + OutputFrm.RichEdit.Lines.Add(title); + outline := 'Test No.'; + for j := 1 to NoVars do + outline := outline + format('%7s',[rowlabels[j]]); + OutputFrm.RichEdit.Lines.Add(outline); + for j := 1 to NoVars do + begin + outline := format('%8s',[rowlabels[j]]); + for k := 1 to NoVars do + begin + outline := outline + format('%7.3f',[Rmat[j,k]]); + end; + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := 'Means '; + for j := 1 to NoVars do outline := outline + format('%7.2f',[means[j]]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := 'Std.Devs'; + for j := 1 to NoVars do outline := outline + format('%7.2f',[stddevs[j]]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + for i := 1 to NoVars do + for j := 1 to NoVars do + RelMat[i,j] := Rmat[i,j]; + for i := 1 to NoVars do + begin + response := InputBox('No. of items in Test ' + IntToStr(i),'Number:','0'); + nitems := StrToInt(response); + Reliabilities[i] := (nitems / (nitems-1) * + (1.0 - (means[i] * (nitems - means[i]))/(nitems * variances[i]))); + RelMat[i,i] := Reliabilities[i]; + cellstring := 'Weight for Test ' + IntToStr(i); + response := InputBox(cellstring,'Weight:','1'); + Weights[i] := StrToFloat(response); + end; + // get numerator and denominator of composite reliability + for i := 1 to NoVars do VectProd[i] := 0.0; + numerator := 0.0; + denominator := 0.0; + for i := 1 to NoVars do + for j := 1 to NoVars do + VectProd[i] := VectProd[i] + (Weights[i] * RelMat[j,i]); + for i := 1 to NoVars do numerator := numerator + (VectProd[i] * Weights[i]); + + for i := 1 to NoVars do VectProd[i] := 0.0; + for i := 1 to NoVars do + for j := 1 to NoVars do + VectProd[i] := VectProd[i] + (Weights[i] * Rmat[j,i]); + for i := 1 to NoVars do denominator := denominator + + (VectProd[i] * Weights[i]); + CompRel := numerator / denominator; + OutputFrm.RichEdit.Lines.Add(''); + outline := 'Test No. Weight Reliability'; + OutputFrm.RichEdit.Lines.Add(outline); + for i := 1 to NoVars do + begin + outline := format(' %3d %6.2f %6.2f',[i,Weights[i],Reliabilities[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := format('Composite reliability = %6.3f',[CompRel]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + response := InputBox('COMPOSITE','Save the composit score?','Yes'); + if response = 'Yes' then + begin + col := 53; + for i := 1 to NoStudents do + begin + X := 0.0; + for j := 1 to NoVars do + X := X + (DataMat[i,j] * Weights[j]); + Grid.Cells[col,i] := FloatToStr(X); + end; + end; +end; + +procedure TGradebookFrm.ClassRptMnuClick(Sender: TObject); +VAR + i, j, pos : integer; + outline : string; + valstr : string; + raw, z, t, p : double; + +begin + // confirm no. of students + NoStudents := 0; + for i := 1 to 40 do + begin + if Grid.Cells[0,i] <> '' then NoStudents := NoStudents + 1; + end; + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Class Report'); + for i := 1 to NoStudents do + begin + outline := Grid.Cells[1,i] + ' '; + if Grid.Cells[2,i] <> '' then outline := outline + Grid.Cells[2,i] + ' '; + outline := outline + Grid.Cells[0,i]; + outline := 'Report for: ' + outline; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('TEST RAW Z T PERCENTILE GRADE'); + OutputFrm.RichEdit.Lines.Add(' NO. SCORE SCORE SCORE RANK'); + for j := 0 to 10 do + begin + pos := j * 5 + 3; + valstr := format('%3d ',[j+1]); + outline := valstr; + if Grid.Cells[pos,i] <> '' then + begin + raw := StrToFloat(Grid.Cells[pos,i]); + z := StrToFloat(Grid.Cells[pos+1,i]); + t := strToFloat(Grid.Cells[pos+2,i]); + p := StrToFloat(Grid.Cells[pos+3,i]); + valstr := format('%10.0f',[raw]); + outline := outline + valstr; + valstr := format('%9.3f %9.3f %9.3f %3s',[z, t, p, Grid.Cells[pos+4,i]]); + outline := outline + valstr; + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add(''); + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; +end; + +procedure TGradebookFrm.FormCreate(Sender: TObject); +begin + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); + + DirectoryEdit1.Directory := GetCurrentDir; + FileListBox1.Directory := DirectoryEdit1.Directory; + FileNameEdit.Text := ''; +end; + +procedure TGradebookFrm.FormShow(Sender: TObject); +begin + Grid.ColWidths[0] := 100; + Grid.Cells[0,0] := 'Last Name'; + Grid.ColWidths[1] := 100; + Grid.Cells[1,0] := 'First Name'; + Grid.ColWidths[2] := 40; + Grid.Cells[2,0] := 'M.I.'; + Grid.ColWidths[3] := 60; + Grid.Cells[3,0] := 'Test 1 Raw'; + Grid.ColWidths[4] := 50; + Grid.Cells[4,0] := 'Test 1 z'; + Grid.ColWidths[5] := 50; + Grid.Cells[5,0] := 'Test 1 T'; + Grid.ColWidths[6] := 55; + Grid.Cells[6,0] := '%ile Rank'; + Grid.ColWidths[7] := 50; + Grid.Cells[7,0] := 'Grade 1'; + Grid.ColWidths[8] := 60; + Grid.Cells[8,0] := 'Test 2 Raw'; + Grid.ColWidths[9] := 50; + Grid.Cells[9,0] := 'Test 2 z'; + Grid.ColWidths[10] := 50; + Grid.Cells[10,0] := 'Test 2 T'; + Grid.ColWidths[11] := 55; + Grid.Cells[11,0] := '%ile Rank'; + Grid.ColWidths[12] := 50; + Grid.Cells[12,0] := 'Grade 2'; + Grid.ColWidths[13] := 60; + Grid.Cells[13,0] := 'Test 3 Raw'; + Grid.ColWidths[14] := 50; + Grid.Cells[14,0] := 'Test 3 z'; + Grid.ColWidths[15] := 50; + Grid.Cells[15,0] := 'Test 3 T'; + Grid.ColWidths[16] := 55; + Grid.Cells[16,0] := '%ile Rank'; + Grid.ColWidths[17] := 50; + Grid.Cells[17,0] := 'Grade 3'; + Grid.ColWidths[18] := 60; + Grid.Cells[18,0] := 'Test 4 Raw'; + Grid.ColWidths[19] := 50; + Grid.Cells[19,0] := 'Test 4 z'; + Grid.ColWidths[20] := 50; + Grid.Cells[20,0] := 'Test 4 T'; + Grid.ColWidths[21] := 55; + Grid.Cells[21,0] := '%ile Rank'; + Grid.ColWidths[22] := 50; + Grid.Cells[22,0] := 'Grade 4'; + Grid.ColWidths[23] := 60; + Grid.Cells[23,0] := 'Test 5 Raw'; + Grid.ColWidths[24] := 50; + Grid.Cells[24,0] := 'Test 5 z'; + Grid.ColWidths[25] := 50; + Grid.Cells[25,0] := 'Test 5 T'; + Grid.ColWidths[26] := 55; + Grid.Cells[26,0] := '%ile Rank'; + Grid.ColWidths[27] := 50; + Grid.Cells[27,0] := 'Grade 5'; + Grid.ColWidths[28] := 60; + Grid.Cells[28,0] := 'Test 6 Raw'; + Grid.ColWidths[29] := 50; + Grid.Cells[29,0] := 'Test 6 z'; + Grid.ColWidths[30] := 50; + Grid.Cells[30,0] := 'Test 6 T'; + Grid.ColWidths[31] := 55; + Grid.Cells[31,0] := '%ile Rank'; + Grid.ColWidths[32] := 50; + Grid.Cells[32,0] := 'Grade 6'; + Grid.ColWidths[33] := 60; + Grid.Cells[33,0] := 'Test 7 Raw'; + Grid.ColWidths[34] := 50; + Grid.Cells[34,0] := 'Test 7 z'; + Grid.ColWidths[35] := 50; + Grid.Cells[35,0] := 'Test 7 T'; + Grid.ColWidths[36] := 55; + Grid.Cells[36,0] := '%ile Rank'; + Grid.ColWidths[37] := 50; + Grid.Cells[37,0] := 'Grade 7'; + Grid.ColWidths[38] := 60; + Grid.Cells[38,0] := 'Test 8 Raw'; + Grid.ColWidths[39] := 50; + Grid.Cells[39,0] := 'Test 8 z'; + Grid.ColWidths[40] := 50; + Grid.Cells[40,0] := 'Test 8 T'; + Grid.ColWidths[41] := 55; + Grid.Cells[41,0] := '%ile Rank'; + Grid.ColWidths[42] := 50; + Grid.Cells[42,0] := 'Grade 8'; + Grid.ColWidths[43] := 60; + Grid.Cells[43,0] := 'Test 9 Raw'; + Grid.ColWidths[44] := 50; + Grid.Cells[44,0] := 'Test 9 z'; + Grid.ColWidths[45] := 50; + Grid.Cells[45,0] := 'Test 9 T'; + Grid.ColWidths[46] := 55; + Grid.Cells[46,0] := '%ile Rank'; + Grid.ColWidths[47] := 50; + Grid.Cells[47,0] := 'Grade 9'; + Grid.ColWidths[48] := 60; + Grid.Cells[48,0] := 'Test 10 Raw'; + Grid.ColWidths[49] := 50; + Grid.Cells[49,0] := 'Test 10 z'; + Grid.ColWidths[50] := 50; + Grid.Cells[50,0] := 'Test 10 T'; + Grid.ColWidths[51] := 55; + Grid.Cells[51,0] := '%ile Rank'; + Grid.ColWidths[52] := 50; + Grid.Cells[52,0] := 'Grade 10'; + Grid.ColWidths[53] := 60; + Grid.Cells[53,0] := 'Total Raw'; + Grid.ColWidths[54] := 50; + Grid.Cells[54,0] := 'Total z'; + Grid.ColWidths[55] := 50; + Grid.Cells[55,0] := 'Total T'; + Grid.ColWidths[56] := 55; + Grid.Cells[56,0] := '%ile Rank'; + Grid.ColWidths[57] := 60; + Grid.Cells[57,0] := 'Final Grade'; +end; + +procedure TGradebookFrm.GridExit(Sender: TObject); +begin + GridCol := Grid.Col; + GridRow := Grid.Row; + if (Grid.Cells[GridCol,GridRow] = ' ') then exit else + begin + NoStudents := GridRow; + if GridCol > 3 then + begin + GridCol := GridCol - 3; + if (GridCol >= 1) and (GridCol <= 5) then + begin + TestNo := 1; + exit; + end; + if (GridCol >= 6) and (GridCol <= 10) then + begin + TestNo := 2; + exit; + end; + if (GridCol >= 11) and (GridCol <= 15) then + begin + TestNo := 3; + exit; + end; + if (GridCol >= 16) and (GridCol <= 20) then + begin + TestNo := 4; + exit; + end; + if (GridCol >= 21) and (GridCol <= 25) then + begin + TestNo := 5; + exit; + end; + if (GridCol >= 26) and (GridCol <= 30) then + begin + TestNo := 6; + exit; + end; + if (GridCol >= 31) and (GridCol <= 35) then + begin + TestNo := 7; + exit; + end; + if (GridCol >= 36) and (GridCol <= 40) then + begin + TestNo := 8; + exit; + end; + if (GridCol >= 41) and (GridCol <= 45) then + begin + TestNo := 9; + exit; + end; + if (GridCol >= 46) and (GridCol <= 50) then + begin + TestNo := 10; + exit; + end; + if (GridCol >= 51) and (GridCol <= 55) then + begin + TestNo := 11; + exit; + end; + end; + end; + if TestNo > NoTests then NoTests := TestNo; +end; + +procedure TGradebookFrm.NewGBMnuClick(Sender: TObject); +VAR + i, j : integer; +begin + for i := 1 to 40 do + begin + for j := 0 to 57 do Grid.Cells[j,i] := ''; + end; + FileNameEdit.text := ''; +end; + +procedure TGradebookFrm.OpenGBMnuClick(Sender: TObject); +var + FName : string; + Book : textfile; + i, j: integer; + cellstr : string; +begin + OpenDialog1.DefaultExt := '.GBK'; + OpenDialog1.Filter := 'ALL (*.*)|*.*|Grade Book (*.GBK)|*.GBK'; + OpenDialog1.FilterIndex := 2; + if OpenDialog1.Execute then + begin + FName := OpenDialog1.FileName; + FileNameEdit.text := FName; + AssignFile(Book,FName); + Reset(Book); + readln(Book,NoStudents); + for i := 1 to 40 do + begin + for j := 0 to 57 do + begin + readln(Book,cellstr); + Grid.Cells[j,i] := cellstr; + end; + end; + CloseFile(Book); + end; +end; + +procedure TGradebookFrm.RadioGroup1Click(Sender: TObject); +begin + if RadioGroup1.ItemIndex = 1 then Grid.FixedCols := 0 else Grid.FixedCols := 3; +end; + +procedure TGradebookFrm.SaveGBMnuClick(Sender: TObject); +var + FName : string; + Book : textfile; + i, j: integer; + cellstr : string; +begin + // confirm no. of students + NoStudents := 0; + for i := 1 to 40 do + begin + if Grid.Cells[0,i] <> '' then NoStudents := NoStudents + 1; + end; + SaveDialog1.DefaultExt := '.GBK'; + SaveDialog1.Filter := 'ALL (*.*)|*.*|Grade Book (*.GBK)|*.GBK'; + SaveDialog1.FilterIndex := 2; + if SaveDialog1.Execute then + begin +// GetNoRecords; + FName := SaveDialog1.FileName; + AssignFile(Book,FName); + Rewrite(Book); + writeln(Book,NoStudents); + for i := 1 to 40 do + begin + for j := 0 to 57 do + begin + cellstr := Grid.Cells[j,i]; + writeln(Book,cellstr); + end; + end; + CloseFile(Book); + end; + FileNameEdit.text := ''; +end; + +procedure TGradebookFrm.StudRptsMnuClick(Sender: TObject); +VAR + i, j, pos : integer; + outline : string; + valstr : string; + raw, z, t, p : double; +begin + // confirm no. of students + NoStudents := 0; + for i := 1 to 40 do + begin + if Grid.Cells[0,i] <> '' then NoStudents := NoStudents + 1; + end; + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Individual Student Report'); + for i := 1 to NoStudents do + begin + outline := Grid.Cells[1,i] + ' '; + if Grid.Cells[2,i] <> '' then outline := outline + Grid.Cells[2,i] + ' '; + outline := outline + Grid.Cells[0,i]; + outline := 'Report for: ' + outline; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('TEST RAW Z T PERCENTILE GRADE'); + OutputFrm.RichEdit.Lines.Add(' NO. SCORE SCORE SCORE RANK'); + for j := 0 to 10 do + begin + pos := j * 5 + 3; + valstr := format('%3d ',[j+1]); + outline := valstr; + if Grid.Cells[pos,i] <> '' then + begin + raw := StrToFloat(Grid.Cells[pos,i]); + z := StrToFloat(Grid.Cells[pos+1,i]); + t := strToFloat(Grid.Cells[pos+2,i]); + p := StrToFloat(Grid.Cells[pos+3,i]); + valstr := format('%10.0f',[raw]); + outline := outline + valstr; + valstr := format('%9.3f %9.3f %9.3f %3s',[z, t, p, Grid.Cells[pos+4,i]]); + outline := outline + valstr; + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; +end; + +procedure TGradebookFrm.TestAnalMnuClick(Sender: TObject); +var + i, j, k, col : integer; + X, mean, variance, stddev, Xtemp : double; + z, t: double; + response : string; + cumfreq : array[0..50] of double; + cumfreqmid : array[0..50] of double; + ncnt : integer; + outline : string; + KR21 : double; + minf, maxf : double; + +begin + response := InputBox('Which test (number)','TEST:','0'); + if StrToInt(response) = 0 then + begin + ShowMessage('You must select a test no. between 1 and 11'); + exit; + end; + tno := StrToInt(response); + tno := tno * 5 - 5; + col := tno + 3; // column of raw scores for test number tno + // get no. of students + NoStudents := 0; + for i := 1 to 40 do + begin + if Grid.Cells[col,i] = '' then continue else NoStudents := NoStudents + 1; + end; + SetLength(sortedraw,41); + SetLength(pcntiles,41,41); + SetLength(tscores,41); + SetLength(zscores,41); + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Test Analysis Results'); + mean := 0.0; + variance := 0.0; + for i := 1 to NoStudents do + begin + X := StrToFloat(Grid.Cells[col,i]); + sortedraw[i-1] := X; + mean := mean + X; + variance := variance + (X * X); + end; + variance := variance - (mean * mean / NoStudents); + Variance := Variance / (NoStudents - 1.0); + stddev := sqrt(variance); + mean := mean / NoStudents; + outline := format('Mean = %8.2f, Variance = %8.3f, Std.Dev. = %8.3f', + [mean,variance,stddev]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + response := InputBox('No. of Test Items or maximum score possible','Number:','0'); + nitems := StrToInt(response); + if nitems = 0 then + begin + ShowMessage('Enter the maximum score or no. of items!'); + exit; + end; + KR21 := (nitems / (nitems-1) * + (1.0 - (mean * (nitems - mean))/(nitems * variance))); + outline := format('Kuder-Richardson Formula 21 Reliability Estimate = %6.4f',[KR21]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + // get z scores and T scores + for i := 1 to NoStudents do + begin + z := (sortedraw[i-1] - mean) / stddev; + outline := format('%5.3f',[z]); + Grid.Cells[col+1,i] := outline; + t := z * 10 + 50; + outline := format('%5.1f',[t]); + Grid.Cells[col+2,i] := outline; + end; + // sort raw scores in ascending order + for i := 1 to NoStudents-1 do + begin + for j := i + 1 to NoStudents do + begin + if sortedraw[i-1] > sortedraw[j-1] then // switch + begin + Xtemp := sortedraw[i-1]; + sortedraw[i-1] := sortedraw[j-1]; + sortedraw[j-1] := Xtemp; + end; + end; + end; + // get percentile rank + ncnt := NoStudents; + nints := 1; + for i := 1 to ncnt do freq[i-1] := 0; + X := sortedraw[0]; + Scores[0] := X; + for i := 1 to ncnt do + begin + if (X = sortedraw[i-1])then freq[nints-1] := freq[nints-1] + 1 + else // new value + begin + nints := nints + 1; + freq[nints-1] := freq[nints-1] + 1; + X := sortedraw[i-1]; + Scores[nints-1] := X; + end; + end; + // get min and max frequencies + minf := NoStudents; + maxf := 0; + for i := 0 to nints - 1 do + begin + if freq[i] > maxf then maxf := freq[i]; + if freq[i] < minf then minf := freq[i]; + end; + // now get cumulative frequencies + cumfreq[0] := freq[0]; + for i := 1 to nints-1 do cumfreq[i] := freq[i] + cumfreq[i-1]; + + // get cumulative frequences to midpoints and percentile ranks + cumfreqmid[0] := freq[0] / 2.0; + pcntilerank[0] := (cumfreq[0] / 2.0) / ncnt; + for i := 1 to nints-1 do + begin + cumfreqmid[i] := (freq[i] / 2.0) + cumfreq[i-1]; + pcntilerank[i] := cumfreqmid[i] / ncnt; + end; + + OutputFrm.RichEdit.Lines.Add('PERCENTILE RANKS'); + OutputFrm.RichEdit.Lines.Add('Score Value Frequency Cum.Freq. Percentile Rank'); + OutputFrm.RichEdit.Lines.Add('___________ __________ __________ ______________'); + for i := 1 to nints do + begin + outline := format(' %8.3f %6.2f %6.2f %6.2f', + [Scores[i-1], freq[i-1],cumfreq[i-1],pcntilerank[i-1]*100.0]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + + // get grades + if GradingFrm = nil then + Application.CreateForm(TGradingFrm, GradingFrm); + GradingFrm.ShowModal; + + // Now place results in testgrid + for i := 1 to ncnt do + begin + X := StrToFloat(Grid.Cells[col,i]); + for j := 0 to nints do + begin + if X = scores[j] then + Grid.Cells[col+3,i] := format('%5.2f',[pcntilerank[j]*100.0]); + end; + end; + OutputFrm.ShowModal; + + // graph raw scores + if maxf = minf then exit; + GraphFrm.Heading := 'Frequency of Raw Scores'; + GraphFrm.XTitle := 'Category'; + GraphFrm.YTitle := 'Frequency'; + SetLength(GraphFrm.Ypoints,1,nints); + SetLength(GraphFrm.Xpoints,1,nints); + for k := 1 to nints do + begin +// GraphFrm.PointLabels[k-1] := GradingSpecs[p].GridData[k,1]; + GraphFrm.Ypoints[0,k-1] := freq[k]; + GraphFrm.Xpoints[0,k-1] := Scores[k]; +// GraphFrm.Ypoints[0,k-1] := freq[k]; +// GraphFrm.Xpoints[0,k-1] := k; + end; + // enter parameters for 2 dimension bars in graph package + GraphFrm.barwideprop := 0.5; + GraphFrm.nosets := 1; + GraphFrm.miny := minf; + GraphFrm.maxy := maxf; + GraphFrm.nbars := nints-1; + GraphFrm.GraphType := 2; // 3d bars + GraphFrm.AutoScaled := false; // use min and max + GraphFrm.ShowLeftWall := true; + GraphFrm.ShowRightWall := true; + GraphFrm.ShowBottomWall := true; + GraphFrm.ShowBackWall := true; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.PtLabels := true; + GraphFrm.ShowModal; + + GraphFrm.Ypoints := nil; + GraphFrm.Xpoints := nil; + +// cleanup + sortedraw := nil; +// grades := nil; + zscores := nil; + tscores := nil; + pcntiles := nil; +end; + + +initialization + {$I gradebookunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/gradingunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/gradingunit.lfm new file mode 100644 index 000000000..60e12ee33 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/gradingunit.lfm @@ -0,0 +1,512 @@ +object GradingFrm: TGradingFrm + Left = 354 + Height = 441 + Top = 163 + Width = 622 + Caption = 'Specification for Grades' + ClientHeight = 441 + ClientWidth = 622 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = ScoresGrid + AnchorSideTop.Control = DistUseGroup + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 130 + Width = 29 + BorderSpacing.Top = 8 + Caption = 'Score' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = DistUseGroup + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ScoresGrid + AnchorSideRight.Side = asrBottom + Left = 79 + Height = 15 + Top = 130 + Width = 55 + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 24 + Caption = 'Frequency' + ParentColor = False + end + object DistUseGroup: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 114 + Top = 8 + Width = 166 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'To Assign Grades Use:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 94 + ClientWidth = 162 + Items.Strings = ( + 'Raw Test Scores' + 'z Scores' + 'T Scores' + 'Percentile Rank Scores' + ) + OnClick = DistUseGroupClick + TabOrder = 0 + end + object CategoriesGroup: TRadioGroup + AnchorSideLeft.Control = DistUseGroup + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + AnchorSideBottom.Control = DistUseGroup + AnchorSideBottom.Side = asrBottom + Left = 190 + Height = 114 + Top = 8 + Width = 279 + Anchors = [akTop, akLeft, akBottom] + AutoFill = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + Caption = 'Use the following Grade Categories:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 94 + ClientWidth = 275 + Items.Strings = ( + 'A, B, C, D, F' + 'A, A-, B+, B, B-, C+, C, C-, D+, D, D-, F' + ) + OnClick = CategoriesGroupClick + TabOrder = 1 + end + object ScoresGrid: TStringGrid + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 245 + Top = 147 + Width = 150 + Anchors = [akTop, akLeft, akBottom] + AutoFillColumns = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 8 + ColCount = 2 + FixedCols = 0 + FixedRows = 0 + TabOrder = 2 + ColWidths = ( + 73 + 73 + ) + end + object SaveBtn: TButton + AnchorSideRight.Control = LoadBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 123 + Height = 25 + Top = 408 + Width = 86 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Save Specs.' + OnClick = SaveBtnClick + TabOrder = 4 + end + object LoadBtn: TButton + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 221 + Height = 25 + Top = 408 + Width = 88 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Load Specs.' + OnClick = LoadBtnClick + TabOrder = 5 + end + object ResetBtn: TButton + AnchorSideRight.Control = Cancelbtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 321 + Height = 25 + Top = 408 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 6 + end + object Cancelbtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 387 + Height = 25 + Top = 408 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 7 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 549 + Height = 25 + Top = 408 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 9 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 461 + Height = 25 + Top = 408 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 8 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 392 + Width = 622 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel6: TPanel + AnchorSideLeft.Control = ScoresGrid + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = DistUseGroup + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 158 + Height = 262 + Top = 130 + Width = 464 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 8 + BevelOuter = bvNone + ChildSizing.EnlargeHorizontal = crsHomogenousSpaceResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 5 + ClientHeight = 262 + ClientWidth = 464 + TabOrder = 3 + object Panel1: TPanel + Left = 15 + Height = 262 + Top = 0 + Width = 75 + BevelOuter = bvNone + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkVertical = crsHomogenousSpaceResize + ClientHeight = 262 + ClientWidth = 75 + TabOrder = 0 + object Label3: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel1 + Left = 5 + Height = 15 + Top = 0 + Width = 64 + BorderSpacing.Bottom = 2 + Caption = 'Grade Given' + ParentColor = False + end + object GradesGrid: TStringGrid + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 245 + Top = 17 + Width = 75 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoFillColumns = True + ColCount = 1 + FixedCols = 0 + FixedRows = 0 + TabOrder = 0 + ColWidths = ( + 71 + ) + end + end + object Panel2: TPanel + Left = 105 + Height = 262 + Top = 0 + Width = 75 + BevelOuter = bvNone + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkVertical = crsHomogenousSpaceResize + ClientHeight = 262 + ClientWidth = 75 + TabOrder = 1 + object Label5: TLabel + AnchorSideLeft.Control = Panel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel2 + Left = 19 + Height = 15 + Top = 0 + Width = 36 + BorderSpacing.Bottom = 2 + Caption = 'Grades' + ParentColor = False + end + object Grades: TStringGrid + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Label5 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 245 + Top = 17 + Width = 75 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoFillColumns = True + BorderSpacing.Top = 2 + ColCount = 1 + FixedCols = 0 + FixedRows = 0 + TabOrder = 0 + ColWidths = ( + 71 + ) + end + end + object Panel3: TPanel + Left = 195 + Height = 262 + Top = 0 + Width = 75 + BevelOuter = bvNone + ClientHeight = 262 + ClientWidth = 75 + TabOrder = 2 + object TopScoreLabel: TLabel + AnchorSideLeft.Control = TopScoreGrid + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel3 + Left = 12 + Height = 15 + Top = 0 + Width = 51 + BorderSpacing.Bottom = 2 + Caption = 'Top Score' + ParentColor = False + end + object TopScoreGrid: TStringGrid + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = TopScoreLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel3 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 245 + Top = 17 + Width = 75 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoFillColumns = True + BorderSpacing.Top = 2 + ColCount = 1 + FixedCols = 0 + FixedRows = 0 + TabOrder = 0 + ColWidths = ( + 71 + ) + end + end + object Panel4: TPanel + Left = 285 + Height = 262 + Top = 0 + Width = 77 + BevelOuter = bvNone + ClientHeight = 262 + ClientWidth = 77 + TabOrder = 3 + object DownThroughLabel: TLabel + AnchorSideLeft.Control = LowScoreGrid + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel4 + Left = -1 + Height = 15 + Top = 0 + Width = 79 + BorderSpacing.Bottom = 2 + Caption = 'Down Through' + ParentColor = False + end + object LowScoreGrid: TStringGrid + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = DownThroughLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel4 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel4 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 245 + Top = 17 + Width = 77 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoFillColumns = True + BorderSpacing.Top = 2 + ColCount = 1 + FixedCols = 0 + FixedRows = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll] + TabOrder = 0 + OnKeyDown = LowScoreGridKeyDown + ColWidths = ( + 73 + ) + end + end + object Panel5: TPanel + Left = 377 + Height = 262 + Top = 0 + Width = 75 + BevelOuter = bvNone + ClientHeight = 262 + ClientWidth = 75 + TabOrder = 4 + object Label4: TLabel + AnchorSideLeft.Control = AssignedGrid + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel5 + Left = 2 + Height = 15 + Top = 0 + Width = 70 + BorderSpacing.Bottom = 2 + Caption = 'No. Assigned' + ParentColor = False + end + object AssignedGrid: TStringGrid + AnchorSideLeft.Control = Panel5 + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel5 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel5 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 245 + Top = 17 + Width = 75 + Anchors = [akTop, akRight, akBottom] + AutoFillColumns = True + BorderSpacing.Top = 2 + ColCount = 1 + FixedCols = 0 + FixedRows = 0 + TabOrder = 0 + ColWidths = ( + 71 + ) + end + end + end + object OpenDialog1: TOpenDialog + left = 496 + top = 24 + end + object SaveDialog1: TSaveDialog + left = 408 + top = 24 + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/gradingunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/gradingunit.pas new file mode 100644 index 000000000..6903d6455 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/gradingunit.pas @@ -0,0 +1,427 @@ +unit GradingUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, Grids, + OutputUnit; + +type + + { TGradingFrm } + + TGradingFrm = class(TForm) + Bevel1: TBevel; + ComputeBtn: TButton; + Label4: TLabel; + AssignedGrid: TStringGrid; + Label5: TLabel; + Grades: TStringGrid; + OpenDialog1: TOpenDialog; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + Panel4: TPanel; + Panel5: TPanel; + Panel6: TPanel; + SaveBtn: TButton; + LoadBtn: TButton; + ResetBtn: TButton; + Cancelbtn: TButton; + ReturnBtn: TButton; + DistUseGroup: TRadioGroup; + CategoriesGroup: TRadioGroup; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + DownThroughLabel: TLabel; + SaveDialog1: TSaveDialog; + ScoresGrid: TStringGrid; + GradesGrid: TStringGrid; + TopScoreGrid: TStringGrid; + LowScoreGrid: TStringGrid; + TopScoreLabel: TLabel; + procedure CategoriesGroupClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure DistUseGroupClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure LoadBtnClick(Sender: TObject); + procedure LowScoreGridKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure ResetBtnClick(Sender: TObject); + procedure SaveBtnClick(Sender: TObject); + private + { private declarations } + nints : integer; + ncases : integer; + col : integer; + ncats : integer; + sorted : array[0..50] of double; + public + { public declarations } + end; + +var + GradingFrm: TGradingFrm; + +implementation + +uses + Math, + gradebookunit; + +{ TGradingFrm } + +procedure TGradingFrm.DistUseGroupClick(Sender: TObject); +VAR + i, j, btn, nscores : integer; + RawScores : array[0..50] of double; + RawFreq : array[0..50] of double; + temp, X, Y : double; +begin + if DistUseGroup.ItemIndex < 0 then exit; + col := gradebookfrm.tno + 3; // column of raw scores for test number tno + btn := DistUseGroup.ItemIndex; + nscores := gradebookfrm.nints; + ScoresGrid.RowCount := nscores; + ncases := gradebookfrm.NoStudents; + case btn of + 0 : TopScoreGrid.Cells[0,0] := IntToStr(gradebookfrm.nitems); + 1 : TopScoreGrid.Cells[0,0] := FloatToStr(3.0); + 2 : TopScoreGrid.Cells[0,0] := FloatToStr(90.0); + 3 : TopScoreGrid.Cells[0,0] := FloatToStr(100.0); + end; + + case btn of + 0 : for i := 1 to ncases do RawScores[i-1] := StrToFloat(gradebookfrm.Grid.Cells[col,i]); + 1 : for i := 1 to ncases do RawScores[i-1] := StrToFloat(gradebookfrm.Grid.Cells[col+1,i]); + 2 : for i := 1 to ncases do RawScores[i-1] := StrToFloat(gradebookfrm.Grid.Cells[col+2,i]); + 3 : for i := 1 to ncases do RawScores[i-1] := StrToFloat(gradebookfrm.Grid.Cells[col+3,i]); + end; + + // sort RawScores into ascending order + for i := 1 to ncases - 1 do + begin + for j := i+1 to ncases do + begin + X := RawScores[i-1]; + Y := RawScores[j-1]; + if RawScores[i-1] < RawScores[j-1] then // switch + begin + temp := RawScores[i-1]; + RawScores[i-1] := RawScores[j-1]; + RawScores[j-1] := temp; + end; + end; + end; + + // get frequency of each score + nints := 1; + for i := 1 to ncases do RawFreq[i-1] := 0; + X := RawScores[0]; + Sorted[0] := X; + for i := 1 to ncases do + begin + if (X = RawScores[i-1])then RawFreq[nints-1] := RawFreq[nints-1] + 1 + else // new value + begin + nints := nints + 1; + RawFreq[nints-1] := RawFreq[nints-1] + 1; + X := RawScores[i-1]; + Sorted[nints-1] := X; + end; + end; + + // put data in grid +// AssignedGrid.RowCount := nints + 1; + ScoresGrid.RowCount := nints+1; + GradesGrid.RowCount := nints + 1; + for i := 0 to nints-1 do + begin + ScoresGrid.Cells[0,i] := FloatToStr(Sorted[i]); + ScoresGrid.Cells[1,i] := FloatToStr(RawFreq[i]); + end; +end; + +procedure TGradingFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure TGradingFrm.FormCreate(Sender: TObject); +begin + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TGradingFrm.FormShow(Sender: TObject); +VAR + i, j : integer; +begin + DistUseGroup.ItemIndex := -1; + CategoriesGroup.ItemIndex := -1; + for i := 0 to ScoresGrid.RowCount-1 do + for j := 0 to 1 do ScoresGrid.Cells[j,i] := ''; + ScoresGrid.RowCount := 5; + for i := 0 to Grades.RowCount-1 do Grades.Cells[0,i] := ''; + Grades.RowCount := 5; + for i := 0 to GradesGrid.RowCount-1 do GradesGrid.Cells[0,i] := ''; + GradesGrid.RowCount := 5; + for i := 0 to TopScoreGrid.RowCount-1 do TopScoreGrid.Cells[0,i] := ''; + TopScoreGrid.RowCount := 5; + for i := 0 to LowScoreGrid.RowCount-1 do LowScoreGrid.Cells[0,i] := ''; + LowScoreGrid.RowCount := 5; + for i := 0 to AssignedGrid.RowCount-1 do AssignedGrid.Cells[0,i] := ''; + AssignedGrid.RowCount := 5; +end; + +procedure TGradingFrm.LoadBtnClick(Sender: TObject); +var + FName : string; + Grading : textfile; + i, j, choice : integer; + cellstring, outline, valstr : string; +begin + OutputFrm.RichEdit.Clear; + OpenDialog1.DefaultExt := '.GRD'; + OpenDialog1.Filter := 'ALL (*.*)|*.*|Test Grading (*.GRD)|*.GRD'; + OpenDialog1.FilterIndex := 2; + if OpenDialog1.Execute then + begin +// GetNoRecords; + FName := OpenDialog1.FileName; + AssignFile(Grading,FName); + Reset(Grading); + readln(Grading,ncases); + readln(Grading,nints); + readln(Grading,col); + readln(Grading,choice); + cellstring := format('Distribution used index = %2d',[choice]); + OutputFrm.RichEdit.Lines.Add(cellstring); +// DistUseGroup.ItemIndex := choice; + readln(Grading,choice); + cellstring := format('Category index = %2d',[choice]); + OutputFrm.RichEdit.Lines.Add(cellstring); +// CategoriesGroup.ItemIndex := choice; + readln(Grading,choice); + OutputFrm.RichEdit.Lines.Add('Top Score Low Score'); + if choice = 0 then + begin + for i := 0 to 4 do + begin + readln(Grading,cellstring); + outline := format('%10s ',[cellstring]); +// TopScoreGrid.Cells[0,i] := cellstring; + readln(Grading,cellstring); + valstr := format('%10s',[cellstring]); + outline := outline + valstr; +// LowScoreGrid.Cells[0,i] := cellstring; + OutputFrm.RichEdit.Lines.Add(outline); + end; + end else + begin + for i := 0 to 11 do + begin + readln(Grading,cellstring); + outline := format('%10s',[cellstring]); +// TopScoreGrid.Cells[0,i] := cellstring; + readln(Grading,cellstring); + valstr := format('%10s',[cellstring]); + outline := outline + valstr; +// LowScoreGrid.Cells[0,i] := cellstring; + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Assigned Grid'); + for i := 0 to nints-1 do + begin + readln(Grading,cellstring); + outline := cellstring; + OutputFrm.RichEdit.Lines.Add(outline); +// AssignedGrid.Cells[0,i] := cellstring; + end; +// readln(Grading,cellstring); + OutputFrm.RichEdit.Lines.Add('Score Frequency'); + for i := 0 to nints - 1 do + begin + outline := ''; + for j := 0 to 1 do + begin + readln(Grading,cellstring); + valstr := format('%10s ',[cellstring]); + outline := outline + valstr; +// ScoresGrid.Cells[j,i] := cellstring; + end; + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + OutputFrm.ShowModal; + CloseFile(Grading); +end; + +procedure TGradingFrm.LowScoreGridKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +VAR + i, row, freq, intervals: integer; + lowval, hival, score1 : double; + +begin + if Key = 13 then // enter key + begin + intervals := ScoresGrid.RowCount-1; + row := LowScoreGrid.Row; + freq := 0; + lowval := StrToFloat(LowScoreGrid.Cells[0,row]); + hival := StrToFloat(TopScoreGrid.Cells[0,row]); + for i := 0 to intervals-1 do + begin + score1 := StrToFloat(ScoresGrid.Cells[0,i]); + if (score1 >= lowval) and (score1 <= hival) then + freq := freq + StrToInt(ScoresGrid.Cells[1,i]); + end; + AssignedGrid.Cells[0,row] := IntToStr(freq); + if row < ncats-1 then + begin + if DistUseGroup.ItemIndex = 1 then // z score + TopScoreGrid.Cells[0,row+1] := FloatToStr(lowval-0.001); + if DistUseGroup.ItemIndex = 0 then // raw score + TopScoreGrid.Cells[0,row+1] := FloatToStr(lowval-1); + if DistUseGroup.ItemIndex = 2 then // T score + TopScoreGrid.Cells[0,row+1] := FloatToStr(lowval-0.1); + if DistUseGroup.ItemIndex = 3 then // Percentile rank + TopScoreGrid.Cells[0,row+1] := FloatToStr(lowval-0.01); + end; + end; +end; + +procedure TGradingFrm.ResetBtnClick(Sender: TObject); +begin + FormShow(self); +end; + +procedure TGradingFrm.SaveBtnClick(Sender: TObject); +var + FName : string; + Grading : textfile; + i, j : integer; +begin + SaveDialog1.DefaultExt := '.GRD'; + SaveDialog1.Filter := 'ALL (*.*)|*.*|Test Grading (*.GRD)|*.GRD'; + SaveDialog1.FilterIndex := 2; + if SaveDialog1.Execute then + begin + FName := SaveDialog1.FileName; + AssignFile(Grading,FName); + Rewrite(Grading); + writeln(Grading,ncases); + writeln(Grading,nints); + writeln(Grading,col); + writeln(Grading,DistUseGroup.ItemIndex); + writeln(Grading,CategoriesGroup.ItemIndex); + if CategoriesGroup.ItemIndex = 0 then + begin + for i := 0 to 4 do + begin + writeln(Grading,TopScoreGrid.Cells[0,i]); + writeln(Grading,LowScoreGrid.Cells[0,i]); + end; + end else + begin + for i := 0 to 11 do + begin + writeln(Grading,TopScoreGrid.Cells[0,i]); + writeln(Grading,LowScoreGrid.Cells[0,i]); + end; + end; + for i := 0 to AssignedGrid.RowCount-1 do + writeln(Grading,AssignedGrid.Cells[0,i]); + for i := 0 to ScoresGrid.RowCount - 1 do + begin + for j := 0 to 1 do writeln(Grading,ScoresGrid.Cells[j,i]); + end; + end; + CloseFile(Grading); +end; + + +procedure TGradingFrm.CategoriesGroupClick(Sender: TObject); +VAR + btn : integer; +begin + btn := CategoriesGroup.ItemIndex; + if btn = 0 then ncats := 5 else ncats := 12; + if btn = 0 then Grades.RowCount := 5 else Grades.RowCount := 12; + if btn = 0 then TopScoreGrid.RowCount := 5 else TopScoreGrid.RowCount := 12; + if btn = 0 then LowScoreGrid.RowCount := 5 else LowScoreGrid.RowCount := 12; + if btn = 0 then AssignedGrid.RowCount := 5 else AssignedGrid.RowCount := 12; + if btn = 0 then + begin + Grades.Cells[0,0] := 'A'; + Grades.Cells[0,1] := 'B'; + Grades.Cells[0,2] := 'C'; + Grades.Cells[0,3] := 'D'; + Grades.Cells[0,4] := 'F'; + end; + if btn = 1 then + begin + Grades.Cells[0,0] := 'A'; + Grades.Cells[0,1] := 'A-'; + Grades.Cells[0,2] := 'B+'; + Grades.Cells[0,3] := 'B'; + Grades.Cells[0,4] := 'B-'; + Grades.Cells[0,5] := 'C+'; + Grades.Cells[0,6] := 'C'; + Grades.Cells[0,7] := 'C-'; + Grades.Cells[0,8] := 'D+'; + Grades.Cells[0,9] := 'D'; + Grades.Cells[0,10] := 'D-'; + Grades.Cells[0,11] := 'F'; + end; +end; + +procedure TGradingFrm.ComputeBtnClick(Sender: TObject); +VAR + i, j: integer; + X, Y, low, hi : double; +begin + // build AssignedGrid of grades for each Score in the ScoresGrid + for i := 0 to ncats - 1 do + begin + hi := StrToFloat(TopScoreGrid.Cells[0,i]); + low := StrToFloat(LowScoreGrid.Cells[0,i]); + for j := 0 to nints-1 do + begin + X := StrToFloat(ScoresGrid.Cells[0,j]); + if (X >= low) and (X <= hi) then GradesGrid.cells[0,j] := Grades.cells[0,i]; + end; + end; + + // Now assign grades in the gradebook + for i := 1 to ncases do // gradebook grade cells + begin + Y := StrToFloat(gradebookfrm.grid.Cells[col,i]); + for j := 0 to nints - 1 do // Grade of values in the ScoreGrid + begin + X := StrToFloat(ScoresGrid.Cells[0,j]); + if X = Y then gradebookfrm.Grid.Cells[col+4,i] := gradesGrid.Cells[0,j]; + end; + end; +end; + +initialization + {$I gradingunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/guttmanunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/guttmanunit.lfm new file mode 100644 index 000000000..a55eb79c4 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/guttmanunit.lfm @@ -0,0 +1,184 @@ +object GuttmanFrm: TGuttmanFrm + Left = 608 + Height = 307 + Top = 322 + Width = 382 + AutoSize = True + Caption = 'Guttman Sclaogram Analysis' + ClientHeight = 307 + ClientWidth = 382 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables Available' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ItemList + AnchorSideTop.Control = Owner + Left = 222 + Height = 15 + Top = 8 + Width = 76 + BorderSpacing.Top = 8 + Caption = 'Selected Items' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 233 + Top = 25 + Width = 152 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 177 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 177 + Height = 28 + Top = 56 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 168 + Height = 25 + Top = 104 + Width = 46 + AutoSize = True + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 3 + end + object ItemList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 222 + Height = 233 + Top = 25 + Width = 152 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 4 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 163 + Height = 25 + Top = 274 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 225 + Height = 25 + Top = 274 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 309 + Height = 25 + Top = 274 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 7 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 258 + Width = 382 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/guttmanunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/guttmanunit.pas new file mode 100644 index 000000000..2b481be52 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/guttmanunit.pas @@ -0,0 +1,650 @@ +unit GuttmanUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, Globals, DataProcs; + +type + + { TGuttmanFrm } + + TGuttmanFrm = class(TForm) + Bevel1: TBevel; + InBtn: TBitBtn; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + ResetBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + Label1: TLabel; + Label2: TLabel; + ItemList: TListBox; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + GuttmanFrm: TGuttmanFrm; + +implementation + +uses + Math; + +{ TGuttmanFrm } + +procedure TGuttmanFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + ItemList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TGuttmanFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TGuttmanFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width + w; // make form a bit wider... + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TGuttmanFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TGuttmanFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TGuttmanFrm.AllBtnClick(Sender: TObject); +var + i: integer; +begin + for i := 0 to VarList.Items.Count - 1 do + ItemList.Items.Add(VarList.Items[i-1]); + VarList.Clear; + UpdateBtnStates; +end; + +procedure TGuttmanFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, col, X, e0, e1, e2, e3, first, last, errors : integer; + totalerrors, rowno : integer; + FreqMat0 : IntDyneMat; // Pointer to array of 0 responses for each item by score group + FreqMat1 : IntDyneMat; // Pointer to array of 1 responses for each item by score group + RowTots : IntDyneVec; // Pointer to vector of total score frequencies for items + ColTots : IntDyneMat; // Pointer to array of 0 and 1 column totals + ColProps : DblDyneVec; // Pointer to array of proportions correct in columns + ColNoSelected : IntDyneVec; // Pointer to vector of item Grid columns + CaseVector : IntDyneVec; // Pointer to vector of subject's item responses + TotalScore : integer; // Total score of a subject + temp : integer; // temporary variable used in sorting + CutScore : IntDyneVec; // Optimal cut scores for each item + ErrorMat : IntDyneMat; // matrix of errors above and below cut scores + sequence : IntDyneVec; // original and sorted sequence no. of items + CaseNo : IntDyneVec; // ID number for each case + ModalArray : IntDyneMat; // Array of modal item responses + NoSelected : integer; + VarLabels : StrDyneVec; // variable labels + outline, astring : string; + done : boolean; + CoefRepro : double; + Min_Coeff : double; + lReport: TStrings; +begin + if ItemList.Count = 0 then + begin + MessageDlg('No variable(s) selected.', mtError, [mbOK], 0); + exit; + end; + + // allocate heap space for arrays + SetLength(ColNoSelected,NoVariables); + SetLength(FreqMat0,NoCases,NoVariables); + SetLength(FreqMat1,NoCases,NoVariables); + SetLength(RowTots,NoCases); + SetLength(ColTots,NoVariables,2); + SetLength(ColProps,NoVariables); + SetLength(CaseVector,NoCases); + SetLength(CutScore,NoCases); + SetLength(ErrorMat,NoVariables,2); + SetLength(sequence,NoVariables); + SetLength(CaseNo,NoCases); + SetLength(ModalArray,NoVariables+1,NoVariables+1); + SetLength(VarLabels,NoVariables); + + // get variables used for the analysis + NoSelected := ItemList.Items.Count; + for i := 1 to NoVariables do + begin + for j := 1 to NoSelected do + begin + if OS3MainFrm.DataGrid.Cells[i,0] = ItemList.Items.Strings[j-1] then + begin + ColNoSelected[j-1] := i; + VarLabels[j-1] := OS3MainFrm.DataGrid.Cells[i,0]; + end; + end; + end; + + // Initialize sequence + for i := 1 to NoSelected do sequence[i-1] := i; + + // Initialize arrays + for i := 0 to NoSelected-1 do + begin + ColTots[i,0] := 0; + ColTots[i,1] := 0; + ColProps[i] := 0.0; + ErrorMat[i,0] := 0; + ErrorMat[i,1] := 0; + end; + for i := 0 to NoCases-1 do + begin + RowTots[i] := 0; + CutScore[i] := 0; + CaseNo[i] := i+1; + for j := 0 to NoSelected-1 do + begin + FreqMat0[i,j] := 0; + FreqMat1[i,j] := 0; + end; + end; + if (NoCases > NoSelected) then + begin + for i := 1 to NoCases do CaseVector[i-1] := 0; + end + else begin + for i := 1 to NoSelected do CaseVector[i-1] := 0; + end; + + // Get data into the frequency matrices of 0 and 1 responses + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + TotalScore := 0; + for j := 1 to NoSelected do + begin + col := ColNoSelected[j-1]; + X := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i]))); + CaseVector[j-1] := X; + TotalScore := TotalScore + X; + end; + for j := 1 to NoSelected do + begin + if (CaseVector[j-1] = 0) then FreqMat0[i-1,j-1] := 1 + else FreqMat1[i-1,j-1] := 1; + end; + end; + + // Get Row Totals for each score group (rows of FreqMat1) + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + for j := 1 to NoSelected do + begin + RowTots[i-1] := RowTots[i-1] + FreqMat1[i-1,j-1]; + end; + end; + + // Get Column Totals for item scores of 1 and 0 + for i := 1 to NoSelected do //columns + begin + for j := 1 to NoCases do // rows + begin + if (not GoodRecord(j,NoSelected,ColNoSelected)) then continue; + ColTots[i-1,0] := ColTots[i-1,0] + FreqMat0[j-1,i-1]; + ColTots[i-1,1] := ColTots[i-1,1] + FreqMat1[j-1,i-1]; + end; + end; + + //Sort frequency matrices into descending order + for i := 1 to NoCases - 1 do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + for j := i + 1 to NoCases do + begin + if (not GoodRecord(j,NoSelected,ColNoSelected)) then continue; + if (RowTots[i-1] < RowTots[j-1]) then //swap + begin + for k := 1 to NoSelected do + begin // carry all columns in the swap + temp := FreqMat0[i-1,k-1]; + FreqMat0[i-1,k-1] := FreqMat0[j-1,k-1]; + FreqMat0[j-1,k-1] := temp; + temp := FreqMat1[i-1,k-1]; + FreqMat1[i-1,k-1] := FreqMat1[j-1,k-1]; + FreqMat1[j-1,k-1] := temp; + end; + // Also swap row totals + temp := RowTots[i-1]; + RowTots[i-1] := RowTots[j-1]; + RowTots[j-1] := temp; + // And case number + temp := CaseNo[i-1]; + CaseNo[i-1] := CaseNo[j-1]; + CaseNo[j-1] := temp; + end; // end if + end; // Next j + end; // next i + + // Now sort the columns into ascending order of number right + for i := 1 to NoSelected - 1 do + begin + for j := i + 1 to NoSelected do + begin + if (ColTots[i-1,1] > ColTots[j-1,1]) then //swap + begin + for k := 1 to NoCases do + begin + if (not GoodRecord(k,NoSelected,ColNoSelected)) then continue; + temp := FreqMat0[k-1,i-1]; + FreqMat0[k-1,i-1] := FreqMat0[k-1,j-1]; + FreqMat0[k-1,j-1] := temp; + temp := FreqMat1[k-1,i-1]; + FreqMat1[k-1,i-1] := FreqMat1[k-1,j-1]; + FreqMat1[k-1,j-1] := temp; + end; // next k + // swap column totals also + temp := ColTots[i-1,0]; + ColTots[i-1,0] := ColTots[j-1,0]; + ColTots[j-1,0] := temp; + temp := ColTots[i-1,1]; + ColTots[i-1,1] := ColTots[j-1,1]; + ColTots[j-1,1] := temp; + // swap label pointers + temp := sequence[i-1]; + sequence[i-1] := sequence[j-1]; + sequence[j-1] := temp; + end; // end if + end; // next j + end; // next i + + //For each item (column), find the optimal cutting value + for i := 1 to NoSelected do + begin + CutScore[i-1] := 0; + for j := 1 to NoCases do // j is the trial cut point + begin + if (not GoodRecord(j,NoSelected,ColNoSelected)) then continue; + e0 := 0; + e1 := 0; + //Get errors prior to the cut point + for k := 1 to j do + begin + if (not GoodRecord(k,NoSelected,ColNoSelected)) then continue; + if (FreqMat0[k-1,i-1] = 1) then e0 := e0 + 1; + end; + //Get errors following the cut point + for k := j + 1 to NoCases do + begin + if (not GoodRecord(k,NoSelected,ColNoSelected)) then continue; + if (FreqMat1[k-1,i-1] = 1) then e1 := e1 + 1; + end; + //Save errors for each cut + CaseVector[j-1] := e0 + e1; + end; // next j + // Save minimum cut score index + e2 := 32000; + e3 := 0; + for j := 1 to NoCases do + begin + if (not GoodRecord(j,NoSelected,ColNoSelected)) then continue; + if (CaseVector[j-1] < e2) then + begin + e2 := CaseVector[j-1]; + e3 := j; + end; + end; + CutScore[i-1] := e3; //Position of optimal cut for item i + end; + + // Get error counts; + for i := 1 to NoSelected do + begin + for j := 1 to CutScore[i-1] do + begin + if (not GoodRecord(j,NoSelected,ColNoSelected)) then continue; + if ((FreqMat0[j-1,i-1] > 0) or (FreqMat1[j-1,i-1] > 0)) then + ErrorMat[i-1,0] := ErrorMat[i-1,0] + FreqMat0[j-1,i-1]; + end; + for j := CutScore[i-1] + 1 to NoCases do + begin + if (not GoodRecord(j,NoSelected,ColNoSelected)) then continue; + if ((FreqMat0[j-1,i-1] > 0) or (FreqMat1[j-1,i-1] > 0)) then + ErrorMat[i-1,1] := ErrorMat[i-1,1] + FreqMat1[j-1,i-1]; + end; + end; + + // Print results + lReport := TStringList.Create; + try + lReport.Add(' GUTTMAN SCALOGRAM ANALYSIS'); + lReport.Add(' Cornell Method'); + lReport.Add(''); + lReport.Add('No. of Cases: %5d', [NoCases]); + lReport.Add('No. of items: %5d', [NoSelected]); + lReport.Add(''); + lReport.Add('RESPONSE MATRIX'); + lReport.Add(''); + first := 1; + last := first + 5; // column (item) index + if (last > NoSelected) then last := NoSelected; + done := false; + + while (not done) do //loop through all of the score groups + begin + lReport.Add('Subject Row Item Number'); + outline := 'Label Sum'; + for i := first to last do + outline := outline + Format('%10s', [VarLabels[sequence[i-1]-1]]); + lReport.Add(outline); + + outline := ' '; + for i := first to last do + outline := outline + ' 0 1 '; + lReport.Add(outline); + lReport.Add(''); + for i := 1 to NoCases do // rows + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + outline := Format(' %3d %3d ', [CaseNo[i-1], RowTots[i-1]]); + for j := first to last do + outline := outline + Format(' %3d %3d ', [FreqMat0[i-1,j-1], FreqMat1[i-1,j-1]]); + lReport.Add(outline); + + // check for optimal cut point for this score + outline := ' '; + for j := first to last do + if (CutScore[j-1] = i) then + outline := outline + ' -cut- ' + else + outline := outline + ' '; + lReport.Add(outline); + end; // Next row (score group) + lReport.Add(''); + + outline := 'TOTALS '; + for j := first to last do + outline := outline + Format(' %3d %3d ', [ColTots[j-1,0], ColTots[j-1,1]]); + lReport.Add(outline); + + outline := 'ERRORS '; + for j := first to last do + outline := outline + Format(' %3d %3d ', [ErrorMat[j-1,0], ErrorMat[j-1,1]]); + lReport.Add(outline); + if (last < NoSelected) then + begin + first := last + 1; + last := first + 5; // column (item) index + if (last > NoSelected) then last := NoSelected; + end + else done := true; + lReport.Add(''); + end; + + lReport.Add(''); + CoefRepro := 0.0; + for j := 1 to NoSelected do + CoefRepro := CoefRepro + ErrorMat[j-1,0] + ErrorMat[j-1,1]; + CoefRepro := 1.0 - (CoefRepro / (NoCases * NoSelected)); + lReport.Add('Coefficient of Reproducibility := %6.3f',[CoefRepro]); + lReport.Add(''); + + + //-----------------------------GOODENOUGH---------------------------------- + // Complete Goodenough method and print results + lReport.Add(''); + lReport.Add(' GUTTMAN SCALOGRAM ANALYSIS'); + lReport.Add(' Goodenough Modification Using Modal Responses'); + lReport.Add(''); + totalerrors := 0; + Min_Coeff := 0.0; + for i := 1 to NoSelected + 1 do + for j := 1 to NoSelected do ModalArray[i-1,j-1] := 0; + for i := 1 to NoSelected do // column + begin + ColProps[i-1] := ColTots[i-1,1] / NoCases; + ErrorMat[i-1,0] := 0; + ErrorMat[i-1,1] := 0; + end; + // Get the cut scores for each score row based on rounded proportions + for i := 1 to NoSelected do + begin + CutScore[i-1] := Trunc(ColProps[i-1] * (NoSelected+1)); + end; + + // Build modal response array for the total scores by items + lReport.Add(''); + lReport.Add(' MODAL ITEM RESPONSES'); + lReport.Add(''); + lReport.Add('TOTAL ITEMS'); + outline := ' '; + for i := 1 to NoSelected do + begin + astring := format('%10s',[VarLabels[sequence[i-1]-1]]); + outline := outline + astring; + end; + lReport.Add(outline); + for i := 0 to NoSelected do + begin + for j := 1 to NoSelected do + if (CutScore[j-1] > i) then + ModalArray[i,j-1] := 1 + else + ModalArray[i,j-1] := 0; + astring := format(' %3d ',[NoSelected - i]); + outline := astring; + for j := 1 to NoSelected do + begin + astring := format(' %3d ',[ModalArray[i,j-1]]); + outline := outline + astring; + end; + lReport.Add(outline); + end; + + lReport.Add(''); + lReport.Add('No. of Cases := %3d. No. of items := %3d',[NoCases,NoSelected]); + lReport.Add(''); + lReport.Add('RESPONSE MATRIX'); + first := 1; + last := first + 5; // column (item) index + if (last > NoSelected) then last := NoSelected; + + done := false; + while (not done) do //loop through all of the score groups + begin + lReport.Add('Subject Row Error Item Number'); + outline := 'Label Sum Count'; + for i := first to last do + outline := outline + Format('%10s', [VarLabels[sequence[i-1]-1]]); + lReport.Add(outline); + outline := ' '; + for i := first to last do + outline := outline + ' 0 1 '; + lReport.Add(outline); + lReport.Add(''); + for i := 1 to NoCases do // rows + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + errors := 0; + for j := first to last do + begin + rowno := NoSelected - RowTots[i-1] + 1; + if (FreqMat1[i-1,j-1] <> ModalArray[rowno-1,j-1]) then errors := errors + 1; + end; + + outline := format(' %3d %3d %3d ',[CaseNo[i-1],RowTots[i-1],errors]); + for j := first to last do + begin + astring := format(' %3d %3d ',[FreqMat0[i-1,j-1],FreqMat1[i-1,j-1]]); + outline := outline + astring; + end; + lReport.Add(outline); + totalerrors := totalerrors + errors; + end; // Next row (score group) + lReport.Add(''); + + outline :='TOTALS '; + for j := first to last do + outline := outline + Format(' %3d %3d ',[ColTots[j-1,0], ColTots[j-1,1]]); + lReport.Add(outline); + + outline := 'PROPORTIONS '; + for j := first to last do + outline := outline + Format('%4.2f %4.2f ',[(1.0-ColProps[j-1]), ColProps[j-1]]); + lReport.Add(outline); + + if (last < NoSelected) then + begin + first := last + 1; + last := first + 5; // column (item) index + if (last > NoSelected) then last := NoSelected; + end + else + done := true; + lReport.Add(''); + end; + lReport.Add(''); + CoefRepro := 1.0 - (totalerrors / (NoCases * NoSelected)); + lReport.Add('Coefficient of Reproducibility := %6.3f', [CoefRepro]); + + for j := 1 to NoSelected do + if (ColProps[j-1] > (1.0 - ColProps[j-1])) then + Min_Coeff := Min_Coeff + ColProps[j-1] + else + Min_Coeff := Min_Coeff + (1.0 - ColProps[j-1]); + Min_Coeff := Min_coeff / NoSelected; + + lReport.Add('Minimal Marginal Reproducibility := %6.3f', [Min_Coeff]); + + DisplayReport(lReport); + finally + lReport.Free; + + // Clean up the heap + VarLabels := nil; + ModalArray := nil; + CaseNo := nil; + sequence := nil; + ErrorMat := nil; + CutScore := nil; + CaseVector := nil; + ColProps := nil; + ColTots := nil; + RowTots := nil; + FreqMat1 := nil; + FreqMat0 := nil; + ColNoSelected := nil; + end; +end; + +procedure TGuttmanFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + ItemList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end + else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TGuttmanFrm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < ItemList.Items.Count do + begin + if ItemList.Selected[i] then + begin + VarList.Items.Add(ItemList.Items[i]); + ItemList.Items.Delete(i); + i := 0; + end + else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TGuttmanFrm.UpdateBtnStates; +var + i: Integer; + lSelected: Boolean; +begin + lSelected := false; + for i := 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + InBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to ItemList.Items.Count-1 do + if ItemList.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; + + AllBtn.Enabled := VarList.Items.Count > 0; +end; + +initialization + {$I guttmanunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/essayitemunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/essayitemunit.lfm new file mode 100644 index 000000000..1217784ab --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/essayitemunit.lfm @@ -0,0 +1,348 @@ +object EssayItemForm: TEssayItemForm + Left = 550 + Height = 426 + Top = 245 + Width = 589 + AutoSize = True + Caption = 'Essay Item Creation and Editing' + ClientHeight = 426 + ClientWidth = 589 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object jpegBrowseBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Image1 + Left = 8 + Height = 25 + Top = 256 + Width = 131 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Browse jpeg Images' + OnClick = jpegBrowseBtnClick + TabOrder = 7 + end + object SelectImageBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = jpegBrowseBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = jpegBrowseBtn + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 26 + Top = 305 + Width = 131 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 24 + Caption = 'Select Shown Image' + OnClick = SelectImageBtnClick + TabOrder = 10 + end + object Image1: TImage + AnchorSideLeft.Control = jpegBrowseBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = jpegnameEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ShowNextBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 147 + Height = 170 + Top = 248 + Width = 178 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 160 + end + object ItemSaveBtn: TButton + AnchorSideLeft.Control = ShowNextBtn + AnchorSideTop.Control = jpegBrowseBtn + AnchorSideRight.Control = ShowNextBtn + AnchorSideRight.Side = asrBottom + Left = 333 + Height = 25 + Top = 256 + Width = 110 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + Caption = 'Save this item' + OnClick = ItemSaveBtnClick + TabOrder = 8 + end + object PreviousBtn: TButton + AnchorSideLeft.Control = ItemSaveBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemSaveBtn + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 451 + Height = 25 + Top = 256 + Width = 130 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Show Previous Item' + OnClick = PreviousBtnClick + TabOrder = 9 + end + object ShowNextBtn: TButton + AnchorSideTop.Control = SelectImageBtn + AnchorSideRight.Control = PreviousBtn + Left = 333 + Height = 25 + Top = 305 + Width = 110 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Show Next Item' + OnClick = ShowNextBtnClick + TabOrder = 11 + end + object StartNewBtn: TButton + AnchorSideLeft.Control = PreviousBtn + AnchorSideTop.Control = ShowNextBtn + AnchorSideRight.Control = PreviousBtn + AnchorSideRight.Side = asrBottom + Left = 451 + Height = 25 + Top = 305 + Width = 130 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + Caption = 'Start a new item' + OnClick = StartNewBtnClick + TabOrder = 12 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 512 + Height = 33 + Top = 385 + Width = 69 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BorderSpacing.InnerBorder = 4 + Caption = 'Return' + OnClick = ReturnBtnClick + TabOrder = 13 + end + object jpeglabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = jpegnameEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 221 + Width = 224 + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'jpeg photo to display prior to item (if any):' + ParentColor = False + end + object jpegnameEdit: TEdit + AnchorSideLeft.Control = jpeglabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = AnswerEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 240 + Height = 23 + Top = 217 + Width = 341 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 6 + Text = 'jpegnameEdit' + end + object TFItemNoLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 128 + Width = 74 + BorderSpacing.Left = 8 + Caption = 'Item Number:' + ParentColor = False + end + object ItemNoEdit: TEdit + AnchorSideLeft.Control = TFItemNoLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 90 + Height = 23 + Top = 124 + Width = 44 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 0 + Text = '1' + end + object ItemCodeLabel: TLabel + AnchorSideLeft.Control = ItemNoEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 150 + Height = 15 + Top = 128 + Width = 92 + BorderSpacing.Left = 16 + Caption = 'Item Major Code:' + ParentColor = False + end + object MajorCodeEdit: TEdit + AnchorSideLeft.Control = ItemCodeLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 250 + Height = 23 + Top = 124 + Width = 41 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 1 + Text = '1' + end + object MinorCodeLabel: TLabel + AnchorSideLeft.Control = MajorCodeEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 307 + Height = 15 + Top = 128 + Width = 93 + BorderSpacing.Left = 16 + Caption = 'Item Minor Code:' + ParentColor = False + end + object MinorCodeEdit: TEdit + AnchorSideLeft.Control = MinorCodeLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 408 + Height = 23 + Top = 124 + Width = 45 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 2 + Text = '0' + end + object ItemStemLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ItemStemEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 159 + Width = 57 + BorderSpacing.Left = 8 + Caption = 'Item Stem:' + ParentColor = False + end + object ItemStemEdit: TEdit + AnchorSideLeft.Control = AnswerEdit + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 89 + Height = 23 + Top = 155 + Width = 492 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 4 + Text = 'ItemStemEdit' + end + object AnswerLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = AnswerEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 190 + Width = 73 + BorderSpacing.Left = 8 + Caption = 'Short Answer:' + ParentColor = False + end + object AnswerEdit: TEdit + AnchorSideLeft.Control = AnswerLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemStemEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 89 + Height = 23 + Top = 186 + Width = 492 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 5 + end + object CodeBrowseBtn: TButton + AnchorSideLeft.Control = MinorCodeEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 477 + Height = 28 + Top = 121 + Width = 106 + BorderSpacing.Left = 24 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Browse Items' + OnClick = CodeBrowseBtnClick + TabOrder = 3 + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 105 + Top = 8 + Width = 573 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Directions: To create an Essay item, you will need to enter the number of an item code which contains both a major code and a minor code. It is suggested you print all item codes from the options menu on the main procedure page of the item banking program. You can however, browse the Essay items from this form.'#13#10'After you have selected an item code number, enter the item stem in the space provided. Your item can also include a jpeg picture prior to the presentation of the item on a test. To find the image, click the jpeg browse button until you see the image you wish to include. When that item is shown, click the Select button to save the name of the image file.' + ParentColor = False + WordWrap = True + end + object OpenPictureDialog1: TOpenPictureDialog + left = 256 + top = 272 + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/essayitemunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/essayitemunit.pas new file mode 100644 index 000000000..848ad1946 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/essayitemunit.pas @@ -0,0 +1,286 @@ +unit EssayItemUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, ExtDlgs, + OutputUnit; + +type + + { TEssayItemForm } + + TEssayItemForm = class(TForm) + AnswerEdit: TEdit; + AnswerLabel: TLabel; + CodeBrowseBtn: TButton; + Image1: TImage; + ItemCodeLabel: TLabel; + ItemSaveBtn: TButton; + ItemStemEdit: TEdit; + ItemStemLabel: TLabel; + jpegBrowseBtn: TButton; + jpeglabel: TLabel; + jpegnameEdit: TEdit; + MajorCodeEdit: TEdit; + Memo1: TLabel; + MinorCodeEdit: TEdit; + MinorCodeLabel: TLabel; + OpenPictureDialog1: TOpenPictureDialog; + PreviousBtn: TButton; + ReturnBtn: TButton; + SelectImageBtn: TButton; + ShowNextBtn: TButton; + StartNewBtn: TButton; + ItemNoEdit: TEdit; + TFItemNoLabel: TLabel; + procedure CodeBrowseBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ItemSaveBtnClick(Sender: TObject); + procedure jpegBrowseBtnClick(Sender: TObject); + procedure PreviousBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure SelectImageBtnClick(Sender: TObject); + procedure ShowNextBtnClick(Sender: TObject); + procedure StartNewBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + EssayItemForm: TEssayItemForm; + +implementation + +uses + ItemBankingUnit; + +{ TEssayItemForm } + +procedure TEssayItemForm.ReturnBtnClick(Sender: TObject); +begin + EssayItemForm.Hide; + Close; +end; + +procedure TEssayItemForm.SelectImageBtnClick(Sender: TObject); +begin + jpegnameEdit.Text := OpenPictureDialog1.FileName; +end; + +procedure TEssayItemForm.ShowNextBtnClick(Sender: TObject); +var + count : integer; + itemno : integer; + JPEG : TJPEGImage; +begin + itemno := StrToInt(ItemNoEdit.Text) + 1; + count := ItemBankFrm.BankInfo.NEssayItems; + if count <= itemno then + begin + ItemNoEdit.Text := IntToStr(ItemBankFrm.EssayInfo[itemno].ItemNumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.EssayInfo[itemno].majorcode) ; + MinorCodeEdit.Text := IntToStr(ItemBankFrm.EssayInfo[itemno].minorcode); + ItemStemEdit.Text := ItemBankFrm.EssayInfo[itemno].ItemStem; + AnswerEdit.Text := ItemBankFrm.EssayInfo[itemno].Answer; + jpegnameEdit.Text := ItemBankFrm.EssayInfo[itemno].PicName; + if (jpegnameEdit.Text <> 'none') and FileExists(jpegnameEdit.Text) then + begin + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(jpegnameEdit.Text); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + Image1.Proportional := true; + end; + end else + Image1.Picture.Clear; + end; +end; + +procedure TEssayItemForm.StartNewBtnClick(Sender: TObject); +var + currentno : integer; +begin + currentno := ItemBankFrm.BankInfo.NEssayItems + 1; + ItemNoEdit.Text := IntToStr(currentno); + currentno := StrToInt(MinorCodeEdit.Text); + MinorCodeEdit.Text := IntToStr(currentno + 1); + ItemStemEdit.Text := ''; + AnswerEdit.Text := ''; + jpegnameEdit.Text := 'none'; + Image1.Picture.Clear; +end; + +procedure TEssayItemForm.ItemSaveBtnClick(Sender: TObject); +var + currentno : integer; + count : integer; +begin + count := ItemBankFrm.BankInfo.NEssayItems; + currentno := StrToInt(ItemNoEdit.Text); + if currentno > count then + begin + ItemBankFrm.BankInfo.NEssayItems := currentno; + ItemBankFrm.NEssayText.Text := IntToStr(currentno); + end; + ItemBankFrm.EssayInfo[currentno].ItemNumber := currentno; + ItemBankFrm.EssayInfo[currentno].majorcode := StrToInt(MajorCodeEdit.Text); + ItemBankFrm.EssayInfo[currentno].minorcode := StrToInt(MinorCodeEdit.Text); + ItemBankFrm.EssayInfo[currentno].ItemStem := ItemStemEdit.Text; + ItemBankFrm.EssayInfo[currentno].Answer := AnswerEdit.text; + ItemBankFrm.EssayInfo[currentno].PicName := jpegnameEdit.Text; +end; + +procedure TEssayItemForm.FormShow(Sender: TObject); +Var + nitems : integer; + JPEG : TJPEGImage; +begin + if ItemBankFrm.BankInfo.NEssayItems > 0 then + begin + nitems := ItemBankFrm.BankInfo.NEssayItems; + ItemNoEdit.Text := '1'; //IntToStr(ItemBankFrm.TFItemInfo[1].ItemNumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.EssayInfo[1].majorcode) ; + MinorCodeEdit.Text := IntToStr(ItemBankFrm.EssayInfo[1].minorcode); + ItemStemEdit.Text := ItemBankFrm.EssayInfo[1].ItemStem; + AnswerEdit.Text := ItemBankFrm.EssayInfo[1].Answer; + jpegnameEdit.Text := ItemBankFrm.EssayInfo[1].PicName; + if (jpegnameEdit.Text <> 'none') and FileExists(jpegnameEdit.Text) then + begin + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(jpegnameEdit.Text); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + Image1.Proportional := true; + end; + end else + Image1.Picture.Clear; + end else + begin + ItemNoEdit.Text := '1'; + MajorCodeEdit.Text := '1'; + MinorCodeEdit.Text := '0'; + ItemStemEdit.Text := ''; + AnswerEdit.Text := ''; + jpegnameEdit.Text := 'none'; + Image1.Picture.Clear; + end; +end; + +procedure TEssayItemForm.CodeBrowseBtnClick(Sender: TObject); +var + count : integer; + i : integer; + outline : string; +begin + OutputFrm.RichEdit.Clear; + count := ItemBankFrm.BankInfo.NTFItems; + OutputFrm.RichEdit.Lines.Add('Current Items'); + OutputFrm.RichEdit.Lines.Add(''); + + for i := 1 to count do + begin + outline := format('Item number %3d',[ItemBankFrm.EssayInfo[i].itemnumber]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Major Code %3d',[ItemBankFrm.EssayInfo[i].majorcode]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Minor Code %3d',[ItemBankFrm.EssayInfo[i].minorcode]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Item Stem %s',[ItemBankFrm.EssayInfo[i].ItemStem]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Breif Answer %s',[ItemBankFrm.EssayInfo[i].Answer]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Graphic Image %s',[ItemBankFrm.EssayInfo[i].PicName]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + end; + OutputFrm.ShowModal; +end; + +procedure TEssayItemForm.FormActivate(Sender: TObject); +begin + if FAutoSized then + exit; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + FAutoSized := True; +end; + +procedure TEssayItemForm.FormCreate(Sender: TObject); +begin + Assert(ItemBankFrm <> nil); + + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TEssayItemForm.jpegBrowseBtnClick(Sender: TObject); +VAR + JPEG : TJPEGImage; +begin + OpenPictureDialog1.Options := OpenPictureDialog1.Options+[ofFileMustExist]; + if not OpenPictureDialog1.Execute then exit; + try + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(OpenPictureDialog1.FileName); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + end; + except + on E: Exception do begin + Image1.Picture.Clear; + MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0); + end; + end; + Image1.Proportional := true; +end; + +procedure TEssayItemForm.PreviousBtnClick(Sender: TObject); +Var + response : string; + itemno : integer; + JPEG : TJPEGImage; +begin + response := InputBox('Code Number:','Number:','1'); + itemno := StrToInt(response); + if itemno <= ItemBankFrm.BankInfo.NEssayItems then + begin + ItemNoEdit.Text := IntToStr(ItemBankFrm.EssayInfo[itemno].ItemNumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.EssayInfo[itemno].majorcode); + MinorCodeEdit.Text := IntToStr(ItemBankFrm.EssayInfo[itemno].minorcode); + ItemStemEdit.Text := ItemBankFrm.EssayInfo[itemno].ItemStem ; + AnswerEdit.Text := ItemBankFrm.EssayInfo[itemno].Answer; + jpegnameEdit.Text := ItemBankFrm.EssayInfo[itemno].PicName; + if (jpegnameEdit.Text <> 'none') and FileExists(jpegnameEdit.Text) then + begin + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(jpegnameEdit.Text); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + Image1.Proportional := true; + end; + end; + end; +end; + +initialization + {$I essayitemunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itembankingunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itembankingunit.lfm new file mode 100644 index 000000000..17bbd1f33 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itembankingunit.lfm @@ -0,0 +1,356 @@ +object ItemBankFrm: TItemBankFrm + Left = 736 + Height = 585 + Top = 241 + Width = 387 + Caption = 'Item Banking' + ClientHeight = 565 + ClientWidth = 387 + Menu = MainMenu1 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + Left = 10 + Height = 15 + Top = 40 + Width = 85 + Caption = 'No. Item Codes:' + ParentColor = False + end + object NItemCodesText: TEdit + AnchorSideLeft.Control = NMCItemsText + AnchorSideTop.Control = BankNameText + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NMCItemsText + AnchorSideRight.Side = asrBottom + Left = 157 + Height = 23 + Top = 35 + Width = 67 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 0 + end + object BankNameLabel: TLabel + AnchorSideTop.Control = BankNameText + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 12 + Width = 91 + Caption = 'Item Bank Name:' + ParentColor = False + end + object BankNameText: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 103 + Height = 23 + Top = 8 + Width = 276 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 1 + end + object NMCItemsLabel: TLabel + AnchorSideTop.Control = NMCItemsText + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 66 + Width = 141 + Caption = 'No. Multiple Choice Items:' + ParentColor = False + end + object NMCItemsText: TEdit + AnchorSideLeft.Control = NMCItemsLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NItemCodesText + AnchorSideTop.Side = asrBottom + Left = 157 + Height = 23 + Top = 62 + Width = 67 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + TabOrder = 2 + end + object TFItemsLabel: TLabel + AnchorSideTop.Control = NTFItemsText + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 93 + Width = 110 + Caption = 'No. True-False Items:' + ParentColor = False + end + object NTFItemsText: TEdit + AnchorSideLeft.Control = NMCItemsText + AnchorSideTop.Control = NMCItemsText + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NMCItemsText + AnchorSideRight.Side = asrBottom + Left = 157 + Height = 23 + Top = 89 + Width = 67 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 3 + end + object NMatchLabel: TLabel + AnchorSideTop.Control = NMatchItemsText + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 120 + Width = 108 + Caption = 'No. Matching Items:' + ParentColor = False + end + object NMatchItemsText: TEdit + AnchorSideLeft.Control = NMCItemsText + AnchorSideTop.Control = NTFItemsText + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NMCItemsText + AnchorSideRight.Side = asrBottom + Left = 157 + Height = 23 + Top = 116 + Width = 67 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 4 + end + object NEssayLabel: TLabel + AnchorSideTop.Control = NEssayText + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 147 + Width = 85 + Caption = 'No. Essay Items:' + ParentColor = False + end + object NEssayText: TEdit + AnchorSideLeft.Control = NMCItemsText + AnchorSideTop.Control = NMatchItemsText + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NMCItemsText + AnchorSideRight.Side = asrBottom + Left = 157 + Height = 23 + Top = 143 + Width = 67 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 5 + end + object FilesLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = DirectoryEdit1 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 296 + Width = 23 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Files' + ParentColor = False + end + object FileListBox1: TFileListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = FilesLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 244 + Top = 313 + Width = 371 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Directory = 'C:\Users\wgmiller\Desktop' + ItemHeight = 0 + TabOrder = 6 + end + object Button1: TButton + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = NSpecifiedEdit + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 25 + Top = 236 + Width = 312 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + Caption = 'Click to Change Directory to Options Default Directory' + OnClick = Button1Click + TabOrder = 7 + end + object DirectoryEdit1: TEdit + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Button1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 23 + Top = 265 + Width = 371 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + TabOrder = 8 + Text = 'DirectoryEdit1' + end + object Label2: TLabel + AnchorSideTop.Control = TestSpecifiedEdit + AnchorSideTop.Side = asrCenter + Left = 10 + Height = 15 + Top = 174 + Width = 76 + Caption = 'Test Specified?' + ParentColor = False + end + object TestSpecifiedEdit: TEdit + AnchorSideLeft.Control = NMCItemsText + AnchorSideTop.Control = NEssayText + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NMCItemsText + AnchorSideRight.Side = asrBottom + Left = 157 + Height = 23 + Top = 170 + Width = 67 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 9 + end + object Label3: TLabel + AnchorSideTop.Control = NSpecifiedEdit + AnchorSideTop.Side = asrCenter + Left = 9 + Height = 15 + Top = 201 + Width = 73 + Caption = 'No. Specified:' + ParentColor = False + end + object NSpecifiedEdit: TEdit + AnchorSideLeft.Control = NMCItemsText + AnchorSideTop.Control = TestSpecifiedEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NMCItemsText + AnchorSideRight.Side = asrBottom + Left = 157 + Height = 23 + Top = 197 + Width = 67 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 10 + Text = 'NSpecifiedEdit' + end + object MainMenu1: TMainMenu + left = 272 + top = 72 + object MenuItem1: TMenuItem + Caption = 'Item Bank' + object OpenItemBank: TMenuItem + Caption = 'Open an existing item bank' + OnClick = OpenItemBankClick + end + object NewItemBank: TMenuItem + Caption = 'Create a new item bank' + OnClick = NewItemBankClick + end + object SaveBankMenu: TMenuItem + Caption = 'Save Current Item Bank' + OnClick = SaveBankMenuClick + end + object ExitThis: TMenuItem + Caption = 'Exit this procedure' + OnClick = ExitThisClick + end + end + object Operations: TMenuItem + Caption = 'Operations' + object CreateCodes: TMenuItem + Caption = 'Create Item Content Codes' + OnClick = CreateCodesClick + end + object ShowCodes: TMenuItem + Caption = 'Display all codes' + OnClick = ShowCodesClick + end + object MCItems: TMenuItem + Caption = 'Create or Edit Multiple Choice Items' + OnClick = MCItemsClick + end + object TFItems: TMenuItem + Caption = 'Create or Edit True-False Items' + OnClick = TFItemsClick + end + object MatchingItems: TMenuItem + Caption = 'Create or Edit Matching Items' + OnClick = MatchingItemsClick + end + object EssayItems: TMenuItem + Caption = 'Create or Edit Essay Items' + OnClick = EssayItemsClick + end + end + object TestOptions: TMenuItem + Caption = 'Test Options' + object TestSpecs: TMenuItem + Caption = 'Specify a test''s Contents' + OnClick = TestSpecsClick + end + object ListItems: TMenuItem + Caption = 'List all test items' + OnClick = ListItemsClick + end + object PrintTest: TMenuItem + Caption = 'Print a test to administer' + OnClick = PrintTestClick + end + end + end + object OpenDialog1: TOpenDialog + left = 272 + top = 184 + end + object SaveDialog1: TSaveDialog + left = 272 + top = 128 + end + object SelDir: TSelectDirectoryDialog + left = 208 + top = 184 + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itembankingunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itembankingunit.pas new file mode 100644 index 000000000..1dfe655a5 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itembankingunit.pas @@ -0,0 +1,765 @@ +unit ItemBankingUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + Menus, StdCtrls, FileCtrl, + Globals, OutputUnit, ItemCodesUnit, TFItemUnit, EssayItemUnit, + MCItemUnit, MatchItemUnit, TestSpecsUnit; + +type + Bank = Record + BankName : string; + NMCItems : integer; + NTFItems : integer; + NMatchItems : integer; + NEssayItems : integer; + NCodes : integer; + TestItems : integer; + end; + +type + MCItem = Record + ItemNumber : integer; + MajorCode : integer; + MinorCode : integer; + NoChoices : integer; + ItemStem : string; + ChoiceOne : string; + ChoiceTwo : string; + ChoiceThree : string; + ChoiceFour : string; + ChoiceFive : string; + CorrectChoice : char; + PicName : string; + end; + +type + TFItem = Record + ItemNumber : integer; + MajorCode : integer; + MinorCode : integer; + ItemStem : string; + CorrectChoice : char; + PicName : string; + end; + +type + MatchItem = Record + ItemNumber : integer; + MajorCode : integer; + MinorCode : integer; + NLeft : integer; + NRight : integer; + Left1 : string; + Left2 : string; + Left3 : string; + Left4 : string; + Left5 : string; + Right1 : string; + Right2 : string; + Right3 : string; + Right4 : string; + Right5 : string; + CorrectChoice : char; + PicName : string; + end; + +type + EssayItem = Record + ItemNumber : integer; + MajorCode : integer; + MinorCode : integer; + ItemStem : string; + Answer : string; + PicName : string; + end; + + +type CodeData = record + codenumber : integer; + majorcodes : integer; + minorcodes : integer; + Description : string; +end; +type testspec = record + ItemNumber : integer; + MajorCode : integer; + MinorCode : integer; + ItemType : string; +end; + +type + + { TItemBankFrm } + + TItemBankFrm = class(TForm) + BankNameLabel: TLabel; + BankNameText: TEdit; + Button1: TButton; + DirectoryEdit1: TEdit; + NSpecifiedEdit: TEdit; + Label3: TLabel; + TestSpecifiedEdit: TEdit; + FileListBox1: TFileListBox; + FilesLabel: TLabel; + Label2: TLabel; + ShowCodes: TMenuItem; + OpenDialog1: TOpenDialog; + SaveBankMenu: TMenuItem; + NEssayText: TEdit; + NEssayLabel: TLabel; + NMatchItemsText: TEdit; + NMatchLabel: TLabel; + NTFItemsText: TEdit; + SaveDialog1: TSaveDialog; + SelDir: TSelectDirectoryDialog; + TFItemsLabel: TLabel; + NMCItemsText: TEdit; + NMCItemsLabel: TLabel; + NItemCodesText: TEdit; + Label1: TLabel; + MainMenu1: TMainMenu; + MenuItem1: TMenuItem; + MCItems: TMenuItem; + MatchingItems: TMenuItem; + EssayItems: TMenuItem; + ListItems: TMenuItem; + ExitThis: TMenuItem; + CreateCodes: TMenuItem; + PrintTest: TMenuItem; + TestSpecs: TMenuItem; + TestOptions: TMenuItem; + TFItems: TMenuItem; + Operations: TMenuItem; + NewItemBank: TMenuItem; + OpenItemBank: TMenuItem; + procedure Button1Click(Sender: TObject); + procedure CreateCodesClick(Sender: TObject); + procedure EssayItemsClick(Sender: TObject); + procedure ExitThisClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ListItemsClick(Sender: TObject); + procedure MatchingItemsClick(Sender: TObject); + procedure MCItemsClick(Sender: TObject); + procedure NewItemBankClick(Sender: TObject); + procedure OpenItemBankClick(Sender: TObject); + procedure PrintTestClick(Sender: TObject); + procedure SaveBankMenuClick(Sender: TObject); + procedure ShowCodesClick(Sender: TObject); + procedure TestSpecsClick(Sender: TObject); + procedure TFItemsClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + CodesInfo : array[1..100] of CodeData; + MCItemInfo : array[1..100] of MCItem; + TFItemInfo : array[1..100] of TFItem; + MatchInfo : array[1..100] of MatchItem; + EssayInfo : array[1..100] of EssayItem; + TestContents : array[1..100] of testspec; + BankInfo : Bank; + // FileName : string; + + end; + +var + ItemBankFrm: TItemBankFrm; + +implementation + +{ TItemBankFrm } + +procedure TItemBankFrm.OpenItemBankClick(Sender: TObject); +var + FileName : string; + BankFile : TextFile; + i : integer; + cellvalue : integer; + nochoices : integer; +begin + OpenDialog1.DefaultExt := '.BNK'; + OpenDialog1.Filter := 'ALL (*.*)|*.*|Item Bank (*.BNK)|*.BNK'; + OpenDialog1.FilterIndex := 2; + if OpenDialog1.Execute then + begin + FileName := OpenDialog1.FileName; + BankNameText.Text := FileName; + FileName := OpenDialog1.FileName; + AssignFile(BankFile,FileName); + Reset(BankFile); + // place all data from the records in this file + // read general BankInfo first + Readln(BankFile,BankInfo.BankName); + Readln(BankFile,BankInfo.NMCItems); + NMCItemsText.Text := IntToStr(BankInfo.NMCItems); + Readln(BankFile,BankInfo.NTFItems); + NTFItemsText.Text := IntToStr(BankInfo.NTFItems); + Readln(BankFile,BankInfo.NMatchItems); + NMatchItemsText.Text := IntToStr(BankInfo.NMatchItems ); + Readln(BankFile,BankInfo.NEssayItems); + NEssayText.Text := IntToStr(BankInfo.NEssayItems ); + Readln(BankFile,BankInfo.NCodes); + NItemCodesText.Text := IntToStr(BankInfo.NCodes); + Readln(BankFile,BankInfo.TestItems); + NSpecifiedEdit.Text := IntToStr(BankInfo.TestItems); +// ShowMessage('Read no. of items by type'); + // now read codes + if BankInfo.Ncodes > 0 then + begin + for i := 1 to BankInfo.NCodes do + begin + Readln(BankFile,cellvalue); + CodesInfo[i].codenumber := cellvalue; + Readln(BankFile,cellvalue); + CodesInfo[i].majorcodes := cellvalue; + Readln(BankFile,cellvalue); + CodesInfo[i].minorcodes := cellvalue; + Readln(BankFile,CodesInfo[i].Description); + end; +// ShowMessage('Read item codes'); + end; + // now read MC items + if BankInfo.NMCItems > 0 then + begin + for i := 1 to BankInfo.NMCItems do + begin + Readln(BankFile,MCItemInfo[i].ItemNumber); + Readln(BankFile,MCItemInfo[i].MajorCode); + Readln(BankFile,MCItemInfo[i].MinorCode); + Readln(BankFile,MCItemInfo[i].NoChoices); + Readln(BankFile,MCItemInfo[i].ItemStem); + nochoices := McItemInfo[i].NoChoices; + if nochoices > 0 then Readln(BankFile,MCItemInfo[i].ChoiceOne); + if nochoices > 1 then Readln(BankFile,MCItemInfo[i].ChoiceTwo); + if nochoices > 2 then Readln(BankFile,MCItemInfo[i].ChoiceThree); + if nochoices > 3 then Readln(BankFile,MCItemInfo[i].ChoiceFour); + if nochoices > 4 then Readln(BankFile,MCItemInfo[i].ChoiceFive); + Readln(BankFile,MCItemInfo[i].CorrectChoice); + Readln(BankFile,MCItemInfo[i].PicName); + end; +// ShowMessage('Read MC items'); + end; + // now read T-F items + if BankInfo.NTFItems > 0 then + begin + for i := 1 to BankInfo.NTFItems do + begin + readln(BankFile,TFItemInfo[i].ItemNumber); + Readln(BankFile,TFItemInfo[i].MajorCode); + Readln(BankFile,TFItemInfo[i].MinorCode); + Readln(BankFile,TFItemInfo[i].ItemStem); + Readln(BankFile,TFItemInfo[i].CorrectChoice); + Readln(BankFile,TFItemInfo[i].PicName); + end; +// ShowMessage('Read True-False items'); + end; + // now read matching items + if BankInfo.NMatchItems > 0 then + begin + for i := 1 to BankInfo.NMatchItems do + begin + Readln(BankFile,MatchInfo[i].ItemNumber); + Readln(BankFile,MatchInfo[i].MajorCode); + Readln(BankFile,MatchInfo[i].MinorCode); + Readln(BankFile,MatchInfo[i].NLeft); + Readln(BankFile,MatchInfo[i].NRight); + nochoices := MatchInfo[i].NLeft; + if nochoices > 0 then Readln(BankFile,MatchInfo[i].Left1); + if nochoices > 1 then Readln(BankFile,MatchInfo[i].Left2); + if nochoices > 2 then Readln(BankFile,MatchInfo[i].Left3); + if nochoices > 3 then Readln(BankFile,MatchInfo[i].Left4); + if nochoices > 4 then Readln(BankFile,MatchInfo[i].Left5); + nochoices := MatchInfo[i].NRight; + if nochoices > 0 then Readln(BankFile,MatchInfo[i].Right1); + if nochoices > 1 then Readln(BankFile,MatchInfo[i].Right2); + if nochoices > 2 then Readln(BankFile,MatchInfo[i].Right3); + if nochoices > 3 then Readln(BankFile,MatchInfo[i].Right4); + if nochoices > 4 then Readln(BankFile,MatchInfo[i].Right5); + Readln(BankFile,MatchInfo[i].CorrectChoice); + Readln(BankFile,MatchInfo[i].PicName); + end; +// ShowMessage('Read Matching items'); + end; + // now read essay items + if BankInfo.NEssayItems > 0 then + begin + for i := 1 to BankInfo.NEssayItems do + begin + Readln(BankFile,EssayInfo[i].ItemNumber); + Readln(BankFile,EssayInfo[i].MajorCode); + Readln(BankFile,EssayInfo[i].MinorCode); + Readln(BankFile,EssayInfo[i].ItemStem); + Readln(BankFile,EssayInfo[i].Answer); + Readln(BankFile,EssayInfo[i].PicName); + end; +// ShowMessage('Read Essay items'); + end; + if BankInfo.TestItems > 0 then + begin + TestSpecifiedEdit.Text := 'Y'; + for i := 1 to BankInfo.TestItems do + begin + readln(BankFile,TestContents[i].ItemNumber); + readln(BankFile,TestContents[i].MajorCode); + readln(BankFile,TestContents[i].MinorCode); + readln(BankFile,TestContents[i].ItemType); + end; + end; + CloseFile(BankFile); + end; +end; + +procedure TItemBankFrm.PrintTestClick(Sender: TObject); +Var + outline : string[180]; + i, nmc, ntf, nessay, nmatch, itemno : integer; + mcitem, tfitem, essayitem, matchitem : integer; + nleft, nright : integer; +begin + itemno := 0; + nmc := StrToInt(NMCItemsText.Text); + ntf := StrToInt(NTFItemsText.Text); + nessay := StrToInt(NEssayText.Text); + nmatch := StrToInt(NMatchItemsText.Text); + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Directions: This test may contain a variety of different item types.'); + OutputFrm.RichEdit.Lines.Add('For each item, circle the correct answer or provide the answer if'); + OutputFrm.RichEdit.Lines.Add('required. You may use the back of the test to provide answers to'); + OutputFrm.RichEdit.Lines.Add('essay questions - just start with the item number.'); + OutputFrm.RichEdit.Lines.Add('Start now!'); + OutputFrm.RichEdit.Lines.Add(''); + if nmc > 0 then + begin + OutputFrm.RichEdit.Lines.Add('MULTIPLE CHOICE ITEMS:'); + for i := 1 to BankInfo.TestItems do + begin + if TestContents[i].ItemType = 'MC' then + begin + itemno := itemno + 1; + outline := format('Item %d',[itemno]); + OutputFrm.RichEdit.Lines.Add(outline); + mcitem := TestContents[i].ItemNumber; + if MCItemInfo[mcitem].PicName <> 'none' then + begin + outline := format('Reference picture = %s',[MCItemInfo[mcitem].PicName]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + { begin + Grect.Top := OutputFrm.RichEdit.Lines.Count ; + Grect.Left := 20; + Grect.Right := 120; + Grect.Bottom := Grect.Top + 120; + JPEG := TJPEGImage.Create; + JPEG.LoadFromFile(MCItemInfo[mcitem].PicName) ; + OutputFrm.Canvas.StretchDraw(Grect,JPEG); + JPEG.Free; + end; } + OutputFrm.RichEdit.Lines.Add(MCItemInfo[mcitem].ItemStem); + nleft := MCItemInfo[mcitem].NoChoices; + OutputFrm.RichEdit.Lines.Add('A. ' + MCItemInfo[mcitem].ChoiceOne); + OutputFrm.RichEdit.Lines.Add('B. ' + MCItemInfo[mcitem].ChoiceTwo); + if nleft > 2 then + OutputFrm.RichEdit.Lines.Add('C. ' + MCItemInfo[mcitem].ChoiceThree); + if nleft > 3 then + OutputFrm.RichEdit.Lines.Add('D. ' + MCItemInfo[mcitem].ChoiceFour); + if nleft > 4 then + OutputFrm.RichEdit.Lines.Add('E. ' + MCItemInfo[mcitem].ChoiceFive); + OutputFrm.RichEdit.Lines.Add(''); + end; + end; + end; + if ntf > 0 then + begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('TRUE OR FALSE ITEMS:'); + for i := 1 to BankInfo.TestItems do + begin + if TestContents[i].ItemType = 'TF' then + begin + itemno := itemno + 1; + outline := format('Item %d',[itemno]); + OutputFrm.RichEdit.Lines.Add(outline); + tfitem := TestContents[i].ItemNumber; + OutputFrm.RichEdit.Lines.Add(TFItemInfo[tfitem].ItemStem); + OutputFrm.RichEdit.Lines.Add('A. TRUE'); + OutputFrm.RichEdit.Lines.Add('B. False'); + end; + end; + OutputFrm.RichEdit.Lines.Add(''); + end; + if nessay > 0 then + begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('ESSAY ITEMS:'); + for i := 1 to BankInfo.TestItems do + begin + if TestContents[i].ItemType = 'Essay' then + begin + itemno := itemno + 1; + outline := format('Item %d',[itemno]); + OutputFrm.RichEdit.Lines.Add(outline); + essayitem := TestContents[i].ItemNumber; + OutputFrm.RichEdit.Lines.Add(EssayInfo[essayitem].ItemStem); + end; + end; + OutputFrm.RichEdit.Lines.Add(''); + end; + if nmatch > 0 then + begin + OutputFrm.RichEdit.Lines.Add('MATCHING ITEMS:'); + for i := 1 to BankInfo.TestItems do + begin + if TestContents[i].ItemType = 'Matching' then + begin + itemno := itemno + 1; + outline := format('Item %d',[itemno]); + OutputFrm.RichEdit.Lines.Add(outline); + matchitem := TestContents[i].ItemNumber; + outline := format('A. %s',[ItemBankFrm.MatchInfo[matchitem].Left1]); + outline := outline + ' 1. '; + outline := outline + ItemBankFrm.MatchInfo[matchitem].Right1 ; + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('B. %s',[ItemBankFrm.MatchInfo[matchitem].Left2]); + nleft := ItemBankFrm.MatchInfo[matchitem].NLeft; + nright := ItemBankFrm.MatchInfo[matchitem].NRight; + if nright > 1 then + begin + outline := outline + ' 2. '; + outline := outline + ItemBankFrm.MatchInfo[matchitem].Right2; + end; + OutputFrm.RichEdit.Lines.Add(outline); + if nleft > 2 then + begin + outline := format('C. %s',[ItemBankFrm.MatchInfo[matchitem].Left3]); + if nright > 2 then + begin + outline := outline + ' 3. '; + outline := outline + ItemBankFrm.MatchInfo[matchitem].Right3; + end; + OutputFrm.RichEdit.Lines.Add(outline); + end; + + if nleft > 3 then + begin + outline := format('D. %s',[ItemBankFrm.MatchInfo[matchitem].Left4]); + if nright > 3 then + begin + outline := outline + ' 4. '; + outline := outline + ItemBankFrm.MatchInfo[matchitem].Right4; + end; + OutputFrm.RichEdit.Lines.Add(outline); + end; + + if nleft > 4 then + begin + outline := format('E. %s',[ItemBankFrm.MatchInfo[matchitem].Left5]); + if nright > 4 then + begin + outline := outline + ' 5. '; + outline := outline + ItemBankFrm.MatchInfo[matchitem].Right5; + end; + OutputFrm.RichEdit.Lines.Add(outline); + end; + + end; +// OutputFrm.RichEdit.Lines.Add(''); + end; + OutputFrm.RichEdit.Lines.Add(''); + end; + OutputFrm.ShowModal; +end; + +procedure TItemBankFrm.SaveBankMenuClick(Sender: TObject); +var + FileName : string; + BankFile : TextFile; + i : integer; + cellvalue : integer; + nochoices : integer; + nspecs : integer; +begin + if BankNameText.Text = '' then Close; + SaveDialog1.DefaultExt := '.BNK'; + SaveDialog1.Filter := 'ALL (*.*)|*.*|ItemBank (*.BNK)|*.BNK'; + SaveDialog1.FilterIndex := 2; + if SaveDialog1.Execute then + begin + FileName := SaveDialog1.FileName; + AssignFile(BankFile,FileName); + Rewrite(BankFile); + BankInfo.BankName := FileName; + // place all data from the records in this file + // write general BankInfo first + writeln(BankFile,BankInfo.BankName); + writeln(BankFile,BankInfo.NMCItems); + writeln(BankFile,BankInfo.NTFItems); + writeln(BankFile,BankInfo.NMatchItems); + writeln(BankFile,BankInfo.NEssayItems); + writeln(BankFile,BankInfo.NCodes); + writeln(BankFile,BankInfo.TestItems); + // now save codes + if BankInfo.NCodes > 0 then + begin + for i := 1 to BankInfo.NCodes do + begin + cellvalue := CodesInfo[i].codenumber; + writeln(BankFile,cellvalue); + cellvalue := CodesInfo[i].majorcodes ; + writeln(BankFile,cellvalue); + cellvalue := CodesInfo[i].minorcodes; + writeln(BankFile,cellvalue); + writeln(BankFile,CodesInfo[i].Description); + end; + end; + // now save MC items + if BankInfo.NMCItems > 0 then + begin + for i := 1 to BankInfo.NMCItems do + begin + nochoices := MCItemInfo[i].NoChoices ; + writeln(BankFile,MCItemInfo[i].ItemNumber); + writeln(BankFile,MCItemInfo[i].MajorCode); + writeln(BankFile,MCItemInfo[i].MinorCode); + writeln(BankFile,MCItemInfo[i].NoChoices); + writeln(BankFile,MCItemInfo[i].ItemStem); + if nochoices > 0 then writeln(BankFile,MCItemInfo[i].ChoiceOne); + if nochoices > 1 then writeln(BankFile,MCItemInfo[i].ChoiceTwo); + if nochoices > 2 then writeln(BankFile,MCItemInfo[i].ChoiceThree); + if nochoices > 3 then writeln(BankFile,MCItemInfo[i].ChoiceFour); + if nochoices > 4 then writeln(BankFile,MCItemInfo[i].ChoiceFive); + writeln(BankFile,MCItemInfo[i].CorrectChoice); + writeln(BankFile,MCItemInfo[i].PicName); + end; + end; + // now save T-F items + if BankInfo.NTFItems > 0 then + begin + for i := 1 to BankInfo.NTFItems do + begin + writeln(BankFile,TFItemInfo[i].ItemNumber); + writeln(BankFile,TFItemInfo[i].MajorCode); + writeln(BankFile,TFItemInfo[i].MinorCode); + writeln(BankFile,TFItemInfo[i].ItemStem); + writeln(BankFile,TFItemInfo[i].CorrectChoice); + writeln(BankFile,TFItemInfo[i].PicName); + end; + end; + // now save matching items + if BankInfo.NMatchItems > 0 then + begin + for i := 1 to BankInfo.NMatchItems do + begin + nochoices := MatchInfo[i].NLeft; + Writeln(BankFile,MatchInfo[i].ItemNumber); + writeln(BankFile,MatchInfo[i].MajorCode); + writeln(BankFile,MatchInfo[i].MinorCode); + writeln(BankFile,MatchInfo[i].NLeft); + writeln(BankFile,MatchInfo[i].NRight); + if nochoices > 0 then writeln(BankFile,MatchInfo[i].Left1); + if nochoices > 1 then writeln(BankFile,MatchInfo[i].Left2); + if nochoices > 2 then writeln(BankFile,MatchInfo[i].Left3); + if nochoices > 3 then writeln(BankFile,MatchInfo[i].Left4); + if nochoices > 4 then writeln(BankFile,MatchInfo[i].Left5); + nochoices := MatchInfo[i].NRight; + if nochoices > 0 then writeln(BankFile,MatchInfo[i].Right1); + if nochoices > 1 then writeln(BankFile,MatchInfo[i].Right2); + if nochoices > 2 then writeln(BankFile,MatchInfo[i].Right3); + if nochoices > 3 then writeln(BankFile,MatchInfo[i].Right4); + if nochoices > 4 then writeln(BankFile,MatchInfo[i].Right5); + writeln(BankFile,MatchInfo[i].CorrectChoice); + writeln(BankFile,MatchInfo[i].PicName); + end; + end; + // now save essay items + if BankInfo.NEssayItems > 0 then + begin + for i := 1 to BankInfo.NEssayItems do + begin + writeln(BankFile,EssayInfo[i].ItemNumber); + writeln(BankFile,EssayInfo[i].MajorCode); + writeln(BankFile,EssayInfo[i].MinorCode); + writeln(BankFile,EssayInfo[i].ItemStem); + writeln(BankFile,EssayInfo[i].Answer); + writeln(BankFile,EssayInfo[i].PicName); + end; + end; + // now save test specifications + nspecs := StrToInt(NSpecifiedEdit.Text); + if nspecs > 0 then + begin + TestSpecifiedEdit.Text := 'Y'; + for i := 1 to TestSpecsForm.testno do + begin + writeln(BankFile,TestContents[i].ItemNumber); + writeln(BankFile,TestContents[i].MajorCode); + writeln(BankFile,TestContents[i].MinorCode); + writeln(BankFile,TestContents[i].ItemType); + end; + end; + CloseFile(BankFile); + end; +end; + +procedure TItemBankFrm.ShowCodesClick(Sender: TObject); +Var + i : integer; + outline : string; + ncodes : integer; +begin +if NItemCodesText.Text <> '' then + begin + OutputFrm.RichEdit.Lines.Add('Current Item Coding Scheme'); + OutputFrm.RichEdit.Lines.Add(''); + ncodes := StrToInt(NItemCodesText.Text); + for i := 1 to ncodes do + begin + outline := format('Code number %d',[i]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Major Code %d',[CodesInfo[i].majorcodes]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Minor Code %d',[CodesInfo[i].minorcodes]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Description %s',[CodesInfo[i].Description]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + end; + OutputFrm.ShowModal; + end; + +end; + +procedure TItemBankFrm.TestSpecsClick(Sender: TObject); +begin + if TestSpecsForm = nil then + Application.CreateForm(TTestSpecsForm, TestSpecsForm); + TestSpecsForm.SpecFileEdit.Text := BankNameText.Text; + TestSpecsForm.MCNoEdit.Text := IntToStr(BankInfo.NMCItems); + TestSpecsForm.TFNoEdit.Text := IntToStr(BankInfo.NTFItems); + TestSpecsForm.EssayNoEdit.Text := IntToStr(BankInfo.NEssayItems); + TestSpecsForm.MatchNoEdit.Text := IntToStr(BankInfo.NMatchItems); + TestSpecsForm.ShowModal; +end; + +procedure TItemBankFrm.TFItemsClick(Sender: TObject); +begin + if TFItemForm = nil then + Application.CreateForm(TTFItemForm, TFItemForm); + TFItemForm.ShowModal; +end; + +procedure TItemBankFrm.NewItemBankClick(Sender: TObject); +Var + response : string; +begin + response := InputBox('SAVE','Save current item bank (Y or N)?','N'); + if response = 'Y' then SaveBankMenuClick(self); + BankNameText.Text := ''; + OpenItemBankClick(self); +end; + +procedure TItemBankFrm.ExitThisClick(Sender: TObject); +Var + response : string; +begin + response := InputBox('SAVE','Save current item bank (Y or N)?','N'); + if response = 'Y' then SaveBankMenuClick(self); + Close; +end; + +procedure TItemBankFrm.FormCreate(Sender: TObject); +begin + Assert(ItemBankFrm <> nil); + + if OutputFrm = nil then + Application.Createform(TOutputFrm, OutputFrm); + + DirectoryEdit1.Text := Options.DefaultPath; + FileListBox1.Directory := DirectoryEdit1.Text; +end; + +procedure TItemBankFrm.FormShow(Sender: TObject); +begin + BankNameText.Text := ''; + NItemCodesText.Text := ''; + NMCItemsText.Text := ''; + NTFItemsText.Text := ''; + NMatchItemsText.Text := ''; + NEssayText.Text := ''; + BankInfo.BankName := ''; + BankInfo.NCodes := 0; + BankInfo.NEssayItems := 0; + BankInfo.NMatchItems := 0; + BankInfo.NTFItems := 0; + BankInfo.NMCItems := 0; + TestSpecifiedEdit.Text := 'N'; + NSpecifiedEdit.Text := ''; +end; + +procedure TItemBankFrm.ListItemsClick(Sender: TObject); +Var + i : integer; + outline : string; +begin + if BankInfo.TestItems > 0 then + begin + OutputFrm.RichEdit.Clear; + for i := 1 to BankInfo.TestItems do + begin + outline := format('Item number: %d',[TestContents[i].ItemNumber]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Major code: %d',[TestContents[i].MajorCode]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Minor code: %d',[TestContents[i].MinorCode]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Item type: %s',[TestContents[i].ItemType]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + OutputFrm.ShowModal; +end; + +procedure TItemBankFrm.MatchingItemsClick(Sender: TObject); +begin + if MatchItemForm = nil then + Application.CreateForm(TMatchItemForm, MatchItemForm); + MatchItemForm.ShowModal; +end; + +procedure TItemBankFrm.MCItemsClick(Sender: TObject); +begin + if MCItemForm = nil then + Application.CreateForm(TMCItemForm, MCItemForm); + MCItemForm.ShowModal; +end; + +procedure TItemBankFrm.CreateCodesClick(Sender: TObject); +begin + if CodesForm = nil then + Application.CreateForm(TCodesForm, CodesForm); + CodesForm.ShowModal; +end; + +procedure TItemBankFrm.Button1Click(Sender: TObject); +begin + DirectoryEdit1.Text := Options.DefaultPath; + FileListBox1.Directory := DirectoryEdit1.Text; +end; + +procedure TItemBankFrm.EssayItemsClick(Sender: TObject); +begin + if EssayItemForm = nil then + Application.CreateForm(TEssayItemForm, EssayItemForm); + EssayItemForm.ShowModal; +end; + +initialization + {$I itembankingunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itemcodesunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itemcodesunit.lfm new file mode 100644 index 000000000..bf33934b8 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itemcodesunit.lfm @@ -0,0 +1,257 @@ +object CodesForm: TCodesForm + Left = 212 + Height = 220 + Top = 126 + Width = 725 + AutoSize = True + Caption = 'Code Creation Form' + ClientHeight = 220 + ClientWidth = 725 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ItemNoLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 118 + Width = 78 + BorderSpacing.Left = 8 + Caption = 'Code Number:' + ParentColor = False + end + object ItemNoEdit: TEdit + AnchorSideLeft.Control = ItemNoLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 94 + Height = 23 + Top = 114 + Width = 37 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + TabOrder = 0 + Text = '1' + end + object MajorLabel: TLabel + AnchorSideLeft.Control = ItemNoEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrCenter + Left = 147 + Height = 15 + Top = 118 + Width = 65 + BorderSpacing.Left = 16 + Caption = 'Major Code:' + ParentColor = False + end + object MajorEdit: TEdit + AnchorSideLeft.Control = MajorLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrCenter + Left = 218 + Height = 23 + Top = 114 + Width = 35 + Alignment = taRightJustify + BorderSpacing.Left = 6 + TabOrder = 1 + Text = '1' + end + object MinorLabel: TLabel + AnchorSideLeft.Control = MajorEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrCenter + Left = 269 + Height = 15 + Top = 118 + Width = 66 + BorderSpacing.Left = 16 + Caption = 'Minor Code:' + ParentColor = False + end + object MinorEdit: TEdit + AnchorSideLeft.Control = MinorLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrCenter + Left = 343 + Height = 23 + Top = 114 + Width = 38 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 2 + Text = '0' + end + object DescLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = DescriptionEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 149 + Width = 111 + BorderSpacing.Left = 8 + Caption = 'Category Description' + ParentColor = False + end + object DescriptionEdit: TEdit + AnchorSideLeft.Control = DescLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 127 + Height = 23 + Top = 145 + Width = 590 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 3 + end + object SaveCodeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = StartNewBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 17 + Height = 25 + Top = 184 + Width = 146 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Save Info. for this code' + OnClick = SaveCodeBtnClick + TabOrder = 4 + end + object StartNewBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = EditOneBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 175 + Height = 25 + Top = 184 + Width = 108 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Start New Code' + OnClick = StartNewBtnClick + TabOrder = 5 + end + object DisplayBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 467 + Height = 25 + Top = 184 + Width = 173 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Display All Saved Code Data' + OnClick = DisplayBtnClick + TabOrder = 7 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 652 + Height = 25 + Top = 184 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + OnClick = ReturnBtnClick + TabOrder = 8 + end + object EditOneBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DisplayBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 295 + Height = 25 + Top = 184 + Width = 160 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Edit a Specific Code Entry' + OnClick = EditOneBtnClick + TabOrder = 6 + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 90 + Top = 8 + Width = 709 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'One of the first steps in creating an item bank is to develop a coding scheme for each item in the item bank of items. You can create up to 100 major and minor codes to describe each item in your bank. Typically, the first item major code is 1 and the corresponding minor code is 0. You will typically have multiple minor coded items under each major code. For example, a major code 1 and minor code 0 might be a major section in a statistics book such as Descriptive Analyses. Under the same major code you might have a minor code 1 to represent items such as the Mean or the Standard Deviation. On this form you will enter the major and minor codes and a description for each one.' + ParentColor = False + WordWrap = True + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = DescriptionEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 168 + Width = 725 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itemcodesunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itemcodesunit.pas new file mode 100644 index 000000000..42c8ffe8b --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/itemcodesunit.pas @@ -0,0 +1,179 @@ +unit ItemCodesUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + OutputUnit; + +type + + { TCodesForm } + + TCodesForm = class(TForm) + Bevel1: TBevel; + EditOneBtn: TButton; + Memo1: TLabel; + ReturnBtn: TButton; + DisplayBtn: TButton; + StartNewBtn: TButton; + SaveCodeBtn: TButton; + DescLabel: TLabel; + DescriptionEdit: TEdit; + MinorEdit: TEdit; + MinorLabel: TLabel; + MajorEdit: TEdit; + ItemNoEdit: TEdit; + ItemNoLabel: TLabel; + MajorLabel: TLabel; + procedure EditOneBtnClick(Sender: TObject); + procedure DisplayBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure SaveCodeBtnClick(Sender: TObject); + procedure StartNewBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + CodesForm: TCodesForm; + +implementation + +uses + ItemBankingUnit; + +{ TCodesForm } + +procedure TCodesForm.SaveCodeBtnClick(Sender: TObject); +var + currentno : integer; +begin + currentno := StrToInt(ItemNoEdit.Text); + if currentno > ItemBankFrm.BankInfo.NCodes then + ItemBankFrm.BankInfo.NCodes := currentno; + ItemBankFrm.NItemCodesText.Text := IntToStr(currentno); + ItemBankFrm.CodesInfo[currentno].codenumber := currentno; + ItemBankFrm.CodesInfo[currentno].majorcodes := StrToInt(MajorEdit.Text); + ItemBankFrm.CodesInfo[currentno].minorcodes := StrToInt(MinorEdit.Text); + ItemBankFrm.CodesInfo[currentno].Description := DescriptionEdit.Text; +end; + +procedure TCodesForm.DisplayBtnClick(Sender: TObject); +var + currentno : integer; + i : integer; + outline : string; +begin + currentno := ItemBankFrm.BankInfo.NCodes; + OutputFrm.RichEdit.Lines.Add('Current Item Codes'); + OutputFrm.RichEdit.Lines.Add(''); + + for i := 1 to currentno do + begin + outline := format('Item number %3d',[ItemBankFrm.CodesInfo[i].codenumber]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Major Code %3d',[ItemBankFrm.CodesInfo[i].majorcodes]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Minor Code %3d',[ItemBankFrm.CodesInfo[i].minorcodes]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Description %s',[ItemBankFrm.CodesInfo[i].Description]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + end; + OutputFrm.ShowModal; +end; + +procedure TCodesForm.EditOneBtnClick(Sender: TObject); +Var + response : string; + codeno : integer; +begin + response := InputBox('Code Number:','Number:','1'); + codeno := StrToInt(response); + if codeno <= ItemBankFrm.BankInfo.NCodes then + begin + ItemNoEdit.Text := IntToStr(ItemBankFrm.CodesInfo[codeno].codenumber); + MajorEdit.Text := IntToStr(ItemBankFrm.CodesInfo[codeno].majorcodes); + MinorEdit.Text := IntToStr(ItemBankFrm.CodesInfo[codeno].minorcodes); + DescriptionEdit.Text := ItemBankFrm.CodesInfo[codeno].Description; + end; +end; + +procedure TCodesForm.FormActivate(Sender: TObject); +begin + if FAutoSized then + exit; + Constraints.MinHeight := Height; + Constraints.MinWidth := Width; + FAutoSized := true; +end; + +procedure TCodesForm.FormCreate(Sender: TObject); +begin + Assert(ItemBankFrm <> nil); + + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + + if ItemBankFrm = nil then + Application.CreateForm(TItemBankFrm, ItemBankFrm); +end; + +procedure TCodesForm.FormShow(Sender: TObject); +Var ncodes : integer; +begin + if ItemBankFrm.NItemCodesText.Text <> '' then + begin + ncodes := StrToInt(ItemBankFrm.NItemCodesText.Text); + ItemNoEdit.Text := IntToStr(ItemBankFrm.CodesInfo[ncodes].codenumber); + MajorEdit.Text := IntToStr(ItemBankFrm.CodesInfo[ncodes].majorcodes) ; + MinorEdit.Text := IntToStr(ItemBankFrm.CodesInfo[ncodes].minorcodes); + DescriptionEdit.Text := ItemBankFrm.CodesInfo[ncodes].Description; + end else + begin + ItemNoEdit.Text := '1'; + MajorEdit.Text := '1'; + MinorEdit.Text := '0'; + DescriptionEdit.Text := ''; + end; +end; + +procedure TCodesForm.ReturnBtnClick(Sender: TObject); +begin + Close; +end; + +procedure TCodesForm.StartNewBtnClick(Sender: TObject); +var + currentno : integer; + newnumber : integer; +begin + currentno := StrToInt(ItemNoEdit.Text); + newnumber := currentno + 1; + ItemNoEdit.Text := IntToStr(newnumber); + currentno := StrToInt(MinorEdit.Text); + newnumber := currentno + 1; + MinorEdit.Text := IntToStr(newnumber); + DescriptionEdit.Text := ''; + if newnumber > StrToInt(ItemBankFrm.NItemCodesText.Text) then + begin + ItemBankFrm.NItemCodesText.Text := IntToStr(newnumber); + ItemBankFrm.CodesInfo[newnumber].codenumber := newnumber; + end; +end; + +initialization + {$I itemcodesunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/matchitemunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/matchitemunit.lfm new file mode 100644 index 000000000..009563974 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/matchitemunit.lfm @@ -0,0 +1,654 @@ +object MatchItemForm: TMatchItemForm + Left = 479 + Height = 578 + Top = 258 + Width = 637 + AutoSize = True + Caption = 'Matching Item Create or Edit Form' + ClientHeight = 578 + ClientWidth = 637 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object jpeglabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = jpegnameEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 381 + Width = 224 + BorderSpacing.Left = 8 + Caption = 'jpeg photo to display prior to item (if any):' + ParentColor = False + end + object jpegnameEdit: TEdit + AnchorSideLeft.Control = jpeglabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = AnswerEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 240 + Height = 23 + Top = 377 + Width = 389 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 7 + Text = 'jpegnameEdit' + end + object jpegBrowseBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Image1 + Left = 8 + Height = 25 + Top = 416 + Width = 131 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Browse jpeg Images' + OnClick = jpegBrowseBtnClick + TabOrder = 8 + end + object SelectImageBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = jpegBrowseBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = jpegBrowseBtn + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 25 + Top = 465 + Width = 131 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 24 + Caption = 'Select Shown Image' + OnClick = SelectImageBtnClick + TabOrder = 11 + end + object ItemSaveBtn: TButton + AnchorSideLeft.Control = ShowNextBtn + AnchorSideTop.Control = jpegBrowseBtn + AnchorSideRight.Control = ShowNextBtn + AnchorSideRight.Side = asrBottom + Left = 381 + Height = 25 + Top = 416 + Width = 110 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + Caption = 'Save this item' + OnClick = ItemSaveBtnClick + TabOrder = 9 + end + object PreviousBtn: TButton + AnchorSideTop.Control = ItemSaveBtn + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 499 + Height = 25 + Top = 416 + Width = 130 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Show Previous Item' + OnClick = PreviousBtnClick + TabOrder = 10 + end + object ShowNextBtn: TButton + AnchorSideTop.Control = SelectImageBtn + AnchorSideRight.Control = PreviousBtn + Left = 381 + Height = 25 + Top = 465 + Width = 110 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Show Next Item' + OnClick = ShowNextBtnClick + TabOrder = 12 + end + object StartNewBtn: TButton + AnchorSideLeft.Control = PreviousBtn + AnchorSideTop.Control = ShowNextBtn + AnchorSideRight.Control = PreviousBtn + AnchorSideRight.Side = asrBottom + Left = 499 + Height = 25 + Top = 465 + Width = 130 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + Caption = 'Start a new item' + OnClick = StartNewBtnClick + TabOrder = 13 + end + object ReturnBtn: TButton + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrCenter + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 560 + Height = 33 + Top = 537 + Width = 69 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BorderSpacing.InnerBorder = 4 + Caption = 'Return' + OnClick = ReturnBtnClick + TabOrder = 14 + end + object Image1: TImage + AnchorSideLeft.Control = jpegBrowseBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = jpegnameEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ShowNextBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 147 + Height = 162 + Top = 408 + Width = 226 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 160 + end + object Label1: TLabel + AnchorSideTop.Control = AnswerEdit + AnchorSideTop.Side = asrCenter + Left = 7 + Height = 15 + Top = 350 + Width = 394 + BorderSpacing.Top = 8 + Caption = 'The Item number in the Right-Hand list that matches the Left-Hand List is: ' + ParentColor = False + end + object AnswerEdit: TEdit + AnchorSideTop.Control = MinorCodeEdit + AnchorSideTop.Side = asrBottom + Left = 407 + Height = 23 + Top = 346 + Width = 36 + BorderSpacing.Top = 8 + TabOrder = 6 + Text = 'AnswerEdit' + end + object TFItemNoLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 319 + Width = 74 + BorderSpacing.Left = 8 + Caption = 'Item Number:' + ParentColor = False + end + object ItemNoEdit: TEdit + AnchorSideLeft.Control = TFItemNoLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 90 + Height = 23 + Top = 315 + Width = 44 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 2 + Text = '1' + end + object ItemCodeLabel: TLabel + AnchorSideLeft.Control = ItemNoEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 150 + Height = 15 + Top = 319 + Width = 92 + BorderSpacing.Left = 16 + Caption = 'Item Major Code:' + ParentColor = False + end + object MajorCodeEdit: TEdit + AnchorSideLeft.Control = ItemCodeLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 250 + Height = 23 + Top = 315 + Width = 41 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 3 + Text = '1' + end + object MinorCodeLabel: TLabel + AnchorSideLeft.Control = MajorCodeEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 307 + Height = 15 + Top = 319 + Width = 93 + BorderSpacing.Left = 16 + Caption = 'Item Minor Code:' + ParentColor = False + end + object MinorCodeEdit: TEdit + AnchorSideLeft.Control = MinorCodeLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 408 + Height = 23 + Top = 315 + Width = 45 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 4 + Text = '0' + end + object CodeBrowseBtn: TButton + AnchorSideLeft.Control = MinorCodeEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox2 + AnchorSideTop.Side = asrBottom + Left = 469 + Height = 25 + Top = 314 + Width = 96 + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + Caption = 'Browse Items' + OnClick = CodeBrowseBtnClick + TabOrder = 5 + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 105 + Top = 8 + Width = 621 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Directions: To create a Matching item, you will need to enter the number of an item code which contains both a major code and a minor code. It is suggested you print all item codes from the options menu on the main procedure page of the item banking program. You can however, browse the Matchin items from this form.'#13#10'After you have selected an item code number, enter the item stem in the space provided. Your item can also include a jpeg picture prior to the presentation of the item on a test. To find the image, click the jpeg browse button until you see the image you wish to include. When that item is shown, click the Select button to save the name of the image file.' + ParentColor = False + WordWrap = True + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Bevel1 + Left = 8 + Height = 177 + Top = 129 + Width = 302 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + Caption = 'Left-Hand List' + ClientHeight = 157 + ClientWidth = 298 + TabOrder = 0 + object Label4: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = Left1Edit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 6 + Width = 14 + BorderSpacing.Left = 12 + Caption = 'A. ' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = Left2Edit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 37 + Width = 13 + BorderSpacing.Left = 12 + Caption = 'B. ' + ParentColor = False + end + object Label6: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = Left3Edit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 68 + Width = 14 + BorderSpacing.Left = 12 + Caption = 'C. ' + ParentColor = False + end + object Label7: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = Left4Edit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 99 + Width = 14 + BorderSpacing.Left = 12 + Caption = 'D. ' + ParentColor = False + end + object Label8: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = Left5Edit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 130 + Width = 12 + BorderSpacing.Left = 12 + Caption = 'E. ' + ParentColor = False + end + object Left1Edit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox1 + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 34 + Height = 23 + Top = 2 + Width = 256 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 0 + Text = 'Left1Edit' + end + object Left5Edit: TEdit + AnchorSideLeft.Control = Left1Edit + AnchorSideTop.Control = Left4Edit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Left1Edit + AnchorSideRight.Side = asrBottom + Left = 34 + Height = 23 + Top = 126 + Width = 256 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + TabOrder = 4 + Text = 'Edit1' + end + object Left4Edit: TEdit + AnchorSideLeft.Control = Left1Edit + AnchorSideTop.Control = Left3Edit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Left1Edit + AnchorSideRight.Side = asrBottom + Left = 34 + Height = 23 + Top = 95 + Width = 256 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 3 + Text = 'Edit1' + end + object Left3Edit: TEdit + AnchorSideLeft.Control = Left1Edit + AnchorSideTop.Control = Left2Edit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Left1Edit + AnchorSideRight.Side = asrBottom + Left = 34 + Height = 23 + Top = 64 + Width = 256 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 2 + Text = 'Edit1' + end + object Left2Edit: TEdit + AnchorSideLeft.Control = Left1Edit + AnchorSideTop.Control = Left1Edit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Left1Edit + AnchorSideRight.Side = asrBottom + Left = 34 + Height = 23 + Top = 33 + Width = 256 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 1 + Text = 'Edit1' + end + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox1 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 326 + Height = 177 + Top = 129 + Width = 303 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Right-Hand List' + ClientHeight = 157 + ClientWidth = 299 + TabOrder = 1 + object Label9: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = Right1Edit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 6 + Width = 12 + BorderSpacing.Left = 12 + Caption = '1. ' + ParentColor = False + end + object Label10: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = Right2Edit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 37 + Width = 12 + BorderSpacing.Left = 12 + Caption = '2. ' + ParentColor = False + end + object Label11: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = Right3Edit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 68 + Width = 12 + BorderSpacing.Left = 12 + Caption = '3. ' + ParentColor = False + end + object Label12: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = Right4Edit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 99 + Width = 12 + BorderSpacing.Left = 12 + Caption = '4. ' + ParentColor = False + end + object Label13: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = Right5Edit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 130 + Width = 12 + BorderSpacing.Left = 12 + Caption = '5. ' + ParentColor = False + end + object Right1Edit: TEdit + AnchorSideLeft.Control = Right5Edit + AnchorSideTop.Control = GroupBox2 + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 32 + Height = 23 + Top = 2 + Width = 259 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 0 + Text = 'Edit1' + end + object Right5Edit: TEdit + AnchorSideLeft.Control = Label13 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Right4Edit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 32 + Height = 23 + Top = 126 + Width = 259 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + TabOrder = 4 + Text = 'Edit1' + end + object Right4Edit: TEdit + AnchorSideLeft.Control = Right5Edit + AnchorSideTop.Control = Right3Edit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 32 + Height = 23 + Top = 95 + Width = 259 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 3 + Text = 'Edit1' + end + object Right3Edit: TEdit + AnchorSideLeft.Control = Right5Edit + AnchorSideTop.Control = Right2Edit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 32 + Height = 23 + Top = 64 + Width = 259 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 2 + Text = 'Edit1' + end + object Right2Edit: TEdit + AnchorSideLeft.Control = Right5Edit + AnchorSideTop.Control = Right1Edit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 32 + Height = 23 + Top = 33 + Width = 259 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 1 + Text = 'Edit1' + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrCenter + Left = 310 + Height = 71 + Top = 182 + Width = 16 + Shape = bsSpacer + end + object Bevel2: TBevel + AnchorSideLeft.Control = ShowNextBtn + AnchorSideTop.Control = Image1 + AnchorSideRight.Control = PreviousBtn + AnchorSideRight.Side = asrBottom + Left = 381 + Height = 8 + Top = 408 + Width = 248 + Anchors = [akTop, akLeft, akRight] + Shape = bsSpacer + end + object OpenPictureDialog1: TOpenPictureDialog + left = 176 + top = 480 + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/matchitemunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/matchitemunit.pas new file mode 100644 index 000000000..1bd850dd2 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/matchitemunit.pas @@ -0,0 +1,457 @@ +unit MatchItemUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, ExtDlgs, OutputUnit; + +type + + { TMatchItemForm } + + TMatchItemForm = class(TForm) + AnswerEdit: TEdit; + Bevel1: TBevel; + Bevel2: TBevel; + CodeBrowseBtn: TButton; + GroupBox1: TGroupBox; + GroupBox2: TGroupBox; + ItemCodeLabel: TLabel; + Left1Edit: TEdit; + Left2Edit: TEdit; + Left5Edit: TEdit; + Left4Edit: TEdit; + Left3Edit: TEdit; + MajorCodeEdit: TEdit; + Memo1: TLabel; + MinorCodeEdit: TEdit; + MinorCodeLabel: TLabel; + Right1Edit: TEdit; + Right5Edit: TEdit; + Right4Edit: TEdit; + Right3Edit: TEdit; + Right2Edit: TEdit; + Image1: TImage; + ItemSaveBtn: TButton; + jpegBrowseBtn: TButton; + jpeglabel: TLabel; + jpegnameEdit: TEdit; + Label1: TLabel; + Label10: TLabel; + Label11: TLabel; + Label12: TLabel; + Label13: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Label7: TLabel; + Label8: TLabel; + Label9: TLabel; + OpenPictureDialog1: TOpenPictureDialog; + PreviousBtn: TButton; + ReturnBtn: TButton; + SelectImageBtn: TButton; + ShowNextBtn: TButton; + StartNewBtn: TButton; + ItemNoEdit: TEdit; + TFItemNoLabel: TLabel; + procedure CodeBrowseBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ItemSaveBtnClick(Sender: TObject); + procedure jpegBrowseBtnClick(Sender: TObject); + procedure PreviousBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure SelectImageBtnClick(Sender: TObject); + procedure ShowNextBtnClick(Sender: TObject); + procedure StartNewBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + MatchItemForm: TMatchItemForm; + +implementation + +uses + ItemBankingUnit; + +{ TMatchItemForm } + +procedure TMatchItemForm.jpegBrowseBtnClick(Sender: TObject); +VAR + JPEG : TJPEGImage; +begin + OpenPictureDialog1.Options := OpenPictureDialog1.Options+[ofFileMustExist]; + if not OpenPictureDialog1.Execute then exit; + try + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(OpenPictureDialog1.FileName); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + end; + except + on E: Exception do begin + Image1.Picture.Clear; + MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0); + end; + end; + Image1.Proportional := true; +end; + +procedure TMatchItemForm.PreviousBtnClick(Sender: TObject); +Var + response : string; + itemno : integer; + JPEG : TJPEGImage; + noleft, noright : integer; +begin + response := InputBox('Code Number:','Number:','1'); + itemno := StrToInt(response); + if itemno <= ItemBankFrm.BankInfo.NMatchItems then + begin + Image1.Canvas.Clear; + ItemNoEdit.Text := IntToStr(ItemBankFrm.MatchInfo[itemno].ItemNumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.MatchInfo[itemno].majorcode); + MinorCodeEdit.Text := IntToStr(ItemBankFrm.MatchInfo[itemno].minorcode); + noleft := ItemBankFrm.MatchInfo[itemno].NLeft; + noright := ItemBankFrm.MatchInfo[itemno].NRight; + if noleft > 0 then Left1Edit.Text := ItemBankFrm.MatchInfo[itemno].Left1; + if noleft > 1 then Left2Edit.Text := ItemBankFrm.MatchInfo[itemno].Left2; + if noleft > 2 then Left3Edit.Text := ItemBankFrm.MatchInfo[itemno].Left3; + if noleft > 3 then Left4Edit.Text := ItemBankFrm.MatchInfo[itemno].Left4; + if noleft > 4 then Left5Edit.Text := ItemBankFrm.MatchInfo[itemno].Left5; + if noright > 0 then Right1Edit.Text := ItemBankFrm.MatchInfo[itemno].Right1; + if noright > 1 then Right2Edit.Text := ItemBankFrm.MatchInfo[itemno].Right2; + if noright > 2 then Right3Edit.Text := ItemBankFrm.MatchInfo[itemno].Right3; + if noright > 3 then Right4Edit.Text := ItemBankFrm.MatchInfo[itemno].Right4; + if noright > 4 then Right5Edit.Text := ItemBankFrm.MatchInfo[itemno].Right5; + AnswerEdit.Text := ItemBankFrm.MatchInfo[itemno].CorrectChoice; + jpegnameEdit.Text := ItemBankFrm.MatchInfo[itemno].PicName; + if (jpegnameEdit.Text <> 'none') and FileExists(jpegnameEdit.Text) then + begin + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(jpegnameEdit.Text); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + Image1.Proportional := true; + end; + end else + Image1.Picture.Clear; + end; +end; + +procedure TMatchItemForm.ReturnBtnClick(Sender: TObject); +begin + MatchItemForm.Hide; + Close; +end; + +procedure TMatchItemForm.ItemSaveBtnClick(Sender: TObject); +var + currentno : integer; + count : integer; + noleft, noright : integer; +begin + count := ItemBankFrm.BankInfo.NMatchItems; + currentno := StrToInt(ItemNoEdit.Text); + noleft := 0; + if Left1Edit.Text <> '' then noleft := noleft + 1; + if Left2Edit.Text <> '' then noleft := noleft + 1; + if Left3Edit.Text <> '' then noleft := noleft + 1; + if Left4Edit.Text <> '' then noleft := noleft + 1; + if Left5Edit.Text <> '' then noleft := noleft + 1; + noright := 0; + if Right1Edit.Text <> '' then noright := noright + 1; + if Right2Edit.Text <> '' then noright := noright + 1; + if Right3Edit.Text <> '' then noright := noright + 1; + if Right4Edit.Text <> '' then noright := noright + 1; + if Right5Edit.Text <> '' then noright := noright + 1; + if currentno > count then + begin + ItemBankFrm.BankInfo.NMatchItems := currentno; + ItemBankFrm.NEssayText.Text := IntToStr(currentno); + end; + ItemBankFrm.MatchInfo[currentno].ItemNumber := currentno; + ItemBankFrm.MatchInfo[currentno].majorcode := StrToInt(MajorCodeEdit.Text); + ItemBankFrm.MatchInfo[currentno].minorcode := StrToInt(MinorCodeEdit.Text); + ItemBankFrm.MatchInfo[currentno].NLeft := noleft; + ItemBankFrm.MatchInfo[currentno].NRight := noright; + if noleft > 0 then ItemBankFrm.MatchInfo[currentno].Left1 := Left1Edit.Text; + if noleft > 1 then ItemBankFrm.MatchInfo[currentno].Left2 := Left2Edit.Text; + if noleft > 2 then ItemBankFrm.MatchInfo[currentno].Left3 := Left3Edit.Text; + if noleft > 3 then ItemBankFrm.MatchInfo[currentno].Left4 := Left4Edit.Text; + if noleft > 4 then ItemBankFrm.MatchInfo[currentno].Left5 := Left5Edit.Text; + if noright > 0 then ItemBankFrm.MatchInfo[currentno].Right1 := Right1Edit.Text; + if noright > 1 then ItemBankFrm.MatchInfo[currentno].Right2 := Right2Edit.Text; + if noright > 2 then ItemBankFrm.MatchInfo[currentno].Right3 := Right3Edit.Text; + if noright > 3 then ItemBankFrm.MatchInfo[currentno].Right4 := Right4Edit.Text; + if noright > 4 then ItemBankFrm.MatchInfo[currentno].Right5 := Right5Edit.Text; + ItemBankFrm.MatchInfo[currentno].CorrectChoice := AnswerEdit.Text[1]; + ItemBankFrm.MatchInfo[currentno].PicName := jpegnameEdit.Text; +end; + +procedure TMatchItemForm.FormShow(Sender: TObject); +Var + nitems : integer; + noleft, noright : integer; + JPEG : TJPEGImage; +begin + Image1.Canvas.Clear; + Left1Edit.Text := ''; + Left2Edit.Text := ''; + Left3Edit.Text := ''; + Left4Edit.Text := ''; + Left5Edit.Text := ''; + Right1Edit.Text := ''; + Right2Edit.Text := ''; + Right3Edit.Text := ''; + Right3Edit.Text := ''; + Right5Edit.Text := ''; + AnswerEdit.Text := ''; + + if ItemBankFrm.BankInfo.NMatchItems > 0 then + begin + nitems := ItemBankFrm.BankInfo.NMatchItems; + ItemNoEdit.Text := '1'; //IntToStr(ItemBankFrm.TFItemInfo[1].ItemNumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.MatchInfo[1].majorcode) ; + MinorCodeEdit.Text := IntToStr(ItemBankFrm.MatchInfo[1].minorcode); + noleft := ItemBankFrm.MatchInfo[1].NLeft; + if noleft > 0 then Left1Edit.Text := ItemBankFrm.MatchInfo[1].Left1 ; + if noleft > 1 then Left2Edit.Text := ItemBankFrm.MatchInfo[1].Left2 ; + if noleft > 2 then Left3Edit.Text := ItemBankFrm.MatchInfo[1].Left3 ; + if noleft > 3 then Left4Edit.Text := ItemBankFrm.MatchInfo[1].Left4 ; + if noleft > 4 then Left5Edit.Text := ItemBankFrm.MatchInfo[1].Left5 ; + noright := ItemBankFrm.MatchInfo[1].NRight; + if noright > 0 then Right1Edit.Text := ItemBankFrm.MatchInfo[1].Right1 ; + if noright > 1 then Right2Edit.Text := ItemBankFrm.MatchInfo[1].Right2 ; + if noright > 2 then Right3Edit.Text := ItemBankFrm.MatchInfo[1].Right3 ; + if noright > 3 then Right4Edit.Text := ItemBankFrm.MatchInfo[1].Right4 ; + if noright > 4 then Right5Edit.Text := ItemBankFrm.MatchInfo[1].Right5 ; + AnswerEdit.Text := ItemBankFrm.MatchInfo[1].CorrectChoice; + jpegnameEdit.Text := ItemBankFrm.MatchInfo[1].PicName; + if (jpegnameEdit.Text <> 'none') and FileExists(jpegNameEdit.Text) then + begin + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(jpegnameEdit.Text); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + Image1.Proportional := true; + end; + end else + Image1.Picture.Clear; + end else + begin + ItemNoEdit.Text := '1'; + MajorCodeEdit.Text := '1'; + MinorCodeEdit.Text := '0'; + Left1Edit.Text := ''; + Left2Edit.Text := ''; + Left3Edit.Text := ''; + Left4Edit.Text := ''; + Left5Edit.Text := ''; + Right1Edit.Text := ''; + Right2Edit.Text := ''; + Right3Edit.Text := ''; + Right3Edit.Text := ''; + Right5Edit.Text := ''; + AnswerEdit.Text := ''; + jpegnameEdit.Text := 'none'; + Image1.Picture.Clear; + end; +end; + +procedure TMatchItemForm.CodeBrowseBtnClick(Sender: TObject); +var + count : integer; + i : integer; + outline : string; + noleft, noright : integer; +begin + OutputFrm.RichEdit.Clear; + count := ItemBankFrm.BankInfo.NMatchItems ; + OutputFrm.RichEdit.Lines.Add('Current Items'); + OutputFrm.RichEdit.Lines.Add(''); + + for i := 1 to count do + begin + noleft := ItemBankFrm.MatchInfo[i].NLeft; + noright := ItemBankFrm.MatchInfo[i].NRight; + outline := format('Item number %3d',[ItemBankFrm.MatchInfo[i].itemnumber]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Major Code %3d',[ItemBankFrm.MatchInfo[i].majorcode]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Minor Code %3d',[ItemBankFrm.MatchInfo[i].minorcode]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('No. Left items = %3d, No. Right items = %3d', + [ItemBankFrm.MatchInfo[i].NLeft,ItemBankFrm.MatchInfo[i].NRight]); + OutputFrm.RichEdit.Lines.Add(outline); + if noleft > 0 then + begin + outline := format('Left Item 1 %s',[ItemBankFrm.MatchInfo[i].Left1]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if noright > 0 then + begin + outline := format(' Right Item 1 %s',[ItemBankFrm.MatchInfo[i].Right1]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if noleft > 1 then + begin + outline := format('Left Item 2 %s',[ItemBankFrm.MatchInfo[i].Left2]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if noright > 1 then + begin + outline := format(' Right Item 2 %s',[ItemBankFrm.MatchInfo[i].Right2]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if noleft > 2 then + begin + outline := format('Left Item 3 %s',[ItemBankFrm.MatchInfo[i].Left3]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if noright > 2 then + begin + outline := format(' Right Item 3 %s',[ItemBankFrm.MatchInfo[i].Right3]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if noleft > 3 then + begin + outline := format('Left Item 4 %s',[ItemBankFrm.MatchInfo[i].Left4]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if noright > 3 then + begin + outline := format(' Right Item 4 %s',[ItemBankFrm.MatchInfo[i].Right4]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if noleft > 4 then + begin + outline := format('Left Item 5 %s',[ItemBankFrm.MatchInfo[i].Left5]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if noright > 4 then + begin + outline := format(' Right Item 5 %s',[ItemBankFrm.MatchInfo[i].Right5]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := format('Correct Choice %s',[ItemBankFrm.MatchInfo[i].CorrectChoice]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Graphic Image %s',[ItemBankFrm.MatchInfo[i].PicName]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + end; + OutputFrm.ShowModal; +end; + +procedure TMatchItemForm.FormActivate(Sender: TObject); +begin + if FAutoSized then + exit; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + FAutoSized := true; +end; + +procedure TMatchItemForm.FormCreate(Sender: TObject); +begin + Assert(ItemBankFrm <> nil); + + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TMatchItemForm.SelectImageBtnClick(Sender: TObject); +begin + jpegnameEdit.Text := OpenPictureDialog1.FileName; +end; + +procedure TMatchItemForm.ShowNextBtnClick(Sender: TObject); +var + count : integer; + itemno : integer; + JPEG : TJPEGImage; + noleft, noright : integer; +begin + itemno := StrToInt(ItemNoEdit.Text) + 1; + count := ItemBankFrm.BankInfo.NMatchItems; + if count <= itemno then + begin + Image1.Canvas.Clear; + ItemNoEdit.Text := IntToStr(ItemBankFrm.MatchInfo[itemno].ItemNumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.MatchInfo[itemno].majorcode) ; + MinorCodeEdit.Text := IntToStr(ItemBankFrm.MatchInfo[itemno].minorcode); + noleft := ItemBankFrm.MatchInfo[itemno].NLeft; + noright := ItemBankFrm.MatchInfo[itemno].NRight; + if noleft > 0 then Left1Edit.Text := ItemBankFrm.MatchInfo[itemno].Left1 ; + if noleft > 1 then Left2Edit.Text := ItemBankFrm.MatchInfo[itemno].Left2; + if noleft > 2 then Left3Edit.Text := ItemBankFrm.MatchInfo[itemno].Left3; + if noleft > 3 then Left4Edit.Text := ItemBankFrm.MatchInfo[itemno].Left4; + if noleft > 4 then Left5Edit.Text := ItemBankFrm.MatchInfo[itemno].Left5; + if noright > 0 then Right1Edit.Text := ItemBankFrm.MatchInfo[itemno].Right1; + if noright > 1 then Right2Edit.Text := ItemBankFrm.MatchInfo[itemno].Right2; + if noright > 2 then Right3Edit.Text := ItemBankFrm.MatchInfo[itemno].Right3; + if noright > 3 then Right4Edit.Text := ItemBankFrm.MatchInfo[itemno].Right4; + if noright > 4 then Right5Edit.Text := ItemBankFrm.MatchInfo[itemno].Right5; + AnswerEdit.Text := ItemBankFrm.MatchInfo[itemno].CorrectChoice; + jpegnameEdit.Text := ItemBankFrm.MatchInfo[itemno].PicName; + if (jpegnameEdit.Text <> 'none') and FileExists(jpegnameEdit.Text) then + begin + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(jpegnameEdit.Text); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + Image1.Proportional := true; + end; + end else + Image1.Picture.Clear; + end; +end; + +procedure TMatchItemForm.StartNewBtnClick(Sender: TObject); +var + currentno : integer; + +begin + Image1.Canvas.Clear; + currentno := ItemBankFrm.BankInfo.NMatchItems + 1; + ItemNoEdit.Text := IntToStr(currentno); + currentno := StrToInt(MinorCodeEdit.Text); + MinorCodeEdit.Text := IntToStr(currentno + 1); + Left1Edit.Text := ''; + Left2Edit.Text := ''; + Left3Edit.Text := ''; + Left4Edit.Text := ''; + Left5Edit.Text := ''; + Right1Edit.Text := ''; + Right2Edit.Text := ''; + Right3Edit.Text := ''; + Right4Edit.Text := ''; + Right5Edit.Text := ''; + AnswerEdit.Text := ''; + jpegnameEdit.Text := 'none'; + Image1.Picture.Clear; +end; + +initialization + {$I matchitemunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/mcitemunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/mcitemunit.lfm new file mode 100644 index 000000000..c8242c89f --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/mcitemunit.lfm @@ -0,0 +1,515 @@ +object MCItemForm: TMCItemForm + Left = 638 + Height = 663 + Top = 205 + Width = 585 + Caption = 'Multiple Choice Item Create or Edit' + ClientHeight = 663 + ClientWidth = 585 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object jpeglabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = jpegnameEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 471 + Width = 224 + BorderSpacing.Left = 8 + Caption = 'jpeg photo to display prior to item (if any):' + ParentColor = False + end + object jpegnameEdit: TEdit + AnchorSideLeft.Control = jpeglabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = AnswerEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 240 + Height = 23 + Top = 467 + Width = 337 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 7 + Text = 'jpegnameEdit' + end + object jpegBrowseBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Image1 + Left = 8 + Height = 25 + Top = 506 + Width = 131 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Browse jpeg Images' + OnClick = jpegBrowseBtnClick + TabOrder = 8 + end + object SelectImageBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = jpegBrowseBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = jpegBrowseBtn + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 25 + Top = 555 + Width = 131 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 24 + Caption = 'Select Shown Image' + OnClick = SelectImageBtnClick + TabOrder = 11 + end + object ItemSaveBtn: TButton + AnchorSideLeft.Control = ShowNextBtn + AnchorSideTop.Control = jpegBrowseBtn + AnchorSideRight.Control = PreviousBtn + Left = 329 + Height = 25 + Top = 506 + Width = 110 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Save this item' + OnClick = ItemSaveBtnClick + TabOrder = 9 + end + object PreviousBtn: TButton + AnchorSideTop.Control = ItemSaveBtn + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 447 + Height = 25 + Top = 506 + Width = 130 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Show Previous Item' + OnClick = PreviousBtnClick + TabOrder = 10 + end + object ShowNextBtn: TButton + AnchorSideTop.Control = SelectImageBtn + AnchorSideRight.Control = PreviousBtn + Left = 329 + Height = 25 + Top = 555 + Width = 110 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Show Next Item' + OnClick = ShowNextBtnClick + TabOrder = 12 + end + object StartNewBtn: TButton + AnchorSideLeft.Control = PreviousBtn + AnchorSideTop.Control = ShowNextBtn + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 447 + Height = 25 + Top = 555 + Width = 130 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Start a new item' + OnClick = StartNewBtnClick + TabOrder = 13 + end + object ReturnBtn: TButton + AnchorSideLeft.Side = asrCenter + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Image1 + AnchorSideBottom.Side = asrBottom + Left = 508 + Height = 33 + Top = 625 + Width = 69 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.InnerBorder = 4 + Caption = 'Return' + OnClick = ReturnBtnClick + TabOrder = 14 + end + object ItemStemLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ItemStemEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 182 + Width = 57 + BorderSpacing.Left = 8 + Caption = 'Item Stem:' + ParentColor = False + end + object ItemStemEdit: TEdit + AnchorSideLeft.Control = ItemStemLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 73 + Height = 23 + Top = 178 + Width = 504 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 4 + Text = 'ItemStemEdit' + end + object AnswerLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = AnswerEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 440 + Width = 116 + BorderSpacing.Left = 8 + Caption = 'Answer (A,B,C,D or F):' + ParentColor = False + end + object AnswerEdit: TEdit + AnchorSideLeft.Control = AnswerLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrBottom + Left = 132 + Height = 23 + Top = 436 + Width = 29 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 6 + end + object Image1: TImage + AnchorSideLeft.Control = jpegBrowseBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = jpegnameEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ShowNextBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 147 + Height = 160 + Top = 498 + Width = 174 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 160 + end + object TFItemNoLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 151 + Width = 74 + BorderSpacing.Left = 8 + Caption = 'Item Number:' + ParentColor = False + end + object ItemNoEdit: TEdit + AnchorSideLeft.Control = TFItemNoLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 90 + Height = 23 + Top = 147 + Width = 44 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 0 + Text = '1' + end + object ItemCodeLabel: TLabel + AnchorSideLeft.Control = ItemNoEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 150 + Height = 15 + Top = 151 + Width = 92 + BorderSpacing.Left = 16 + Caption = 'Item Major Code:' + ParentColor = False + end + object MajorCodeEdit: TEdit + AnchorSideLeft.Control = ItemCodeLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 250 + Height = 23 + Top = 147 + Width = 41 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 1 + Text = '1' + end + object MinorCodeLabel: TLabel + AnchorSideLeft.Control = MajorCodeEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 307 + Height = 15 + Top = 151 + Width = 93 + BorderSpacing.Left = 16 + Caption = 'Item Minor Code:' + ParentColor = False + end + object MinorCodeEdit: TEdit + AnchorSideLeft.Control = MinorCodeLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 408 + Height = 23 + Top = 147 + Width = 45 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 2 + Text = '0' + end + object CodeBrowseBtn: TButton + AnchorSideLeft.Control = MinorCodeEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 469 + Height = 28 + Top = 144 + Width = 106 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = 'Browse Items' + OnClick = CodeBrowseBtnClick + TabOrder = 3 + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 120 + Top = 8 + Width = 569 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Directions: To create a Multiple Choice item, you will need to enter the number of an item code which contains both a major code and a minor code. It is suggested you print all item codes from the options menu on the main procedure page of the item banking program. You can however, browse the MC items from this form.'#13#10'After you have selected an item code number, enter the item stem in the space provided. Your item can also include a jpeg picture prior to the presentation of the item on a test. To find the image, click the jpeg browse button until you see the image you wish to include. When that item is shown, click the Select button to save the name of the image file.' + ParentColor = False + WordWrap = True + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ItemStemEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 219 + Top = 209 + Width = 569 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Choices' + ClientHeight = 199 + ClientWidth = 565 + TabOrder = 5 + object Label7: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = NoChoicesEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 6 + Width = 223 + BorderSpacing.Left = 12 + Caption = 'Enter number of choices and press return: ' + ParentColor = False + end + object NoChoicesEdit: TEdit + AnchorSideLeft.Control = Label7 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox1 + Left = 243 + Height = 23 + Top = 2 + Width = 32 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + OnChange = NoChoicesEditChange + TabOrder = 0 + Text = '0' + end + object Label2: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = ChoiceAEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 44 + Width = 14 + BorderSpacing.Left = 12 + Caption = 'A. ' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = ChoiceBEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 76 + Width = 13 + BorderSpacing.Left = 12 + Caption = 'B. ' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = ChoiceCEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 108 + Width = 14 + BorderSpacing.Left = 12 + Caption = 'C. ' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = ChoiceDEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 140 + Width = 14 + BorderSpacing.Left = 12 + Caption = 'D. ' + ParentColor = False + end + object Label6: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = ChoiceEEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 172 + Width = 12 + BorderSpacing.Left = 12 + Caption = 'E. ' + ParentColor = False + end + object ChoiceAEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 34 + Height = 23 + Top = 40 + Width = 523 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + TabOrder = 1 + Text = 'ChoiceAEdit' + end + object ChoiceDEdit: TEdit + AnchorSideLeft.Control = ChoiceAEdit + AnchorSideRight.Control = ChoiceAEdit + AnchorSideRight.Side = asrBottom + Left = 34 + Height = 23 + Top = 136 + Width = 523 + Anchors = [akTop, akLeft, akRight] + TabOrder = 4 + Text = 'Edit1' + end + object ChoiceEEdit: TEdit + AnchorSideLeft.Control = ChoiceAEdit + AnchorSideRight.Control = ChoiceAEdit + AnchorSideRight.Side = asrBottom + Left = 34 + Height = 23 + Top = 168 + Width = 523 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Bottom = 8 + TabOrder = 5 + Text = 'Edit1' + end + object ChoiceCEdit: TEdit + AnchorSideLeft.Control = ChoiceAEdit + AnchorSideRight.Control = ChoiceAEdit + AnchorSideRight.Side = asrBottom + Left = 34 + Height = 23 + Top = 104 + Width = 523 + Anchors = [akTop, akLeft, akRight] + TabOrder = 3 + Text = 'Edit1' + end + object ChoiceBEdit: TEdit + AnchorSideLeft.Control = ChoiceAEdit + AnchorSideRight.Control = ChoiceAEdit + AnchorSideRight.Side = asrBottom + Left = 34 + Height = 23 + Top = 72 + Width = 523 + Anchors = [akTop, akLeft, akRight] + TabOrder = 2 + Text = 'Edit1' + end + end + object OpenPictureDialog1: TOpenPictureDialog + left = 224 + top = 512 + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/mcitemunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/mcitemunit.pas new file mode 100644 index 000000000..0cd1a6325 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/mcitemunit.pas @@ -0,0 +1,406 @@ +unit MCItemUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, ExtDlgs, + OutputUnit; + +type + + { TMCItemForm } + + TMCItemForm = class(TForm) + AnswerEdit: TEdit; + AnswerLabel: TLabel; + ChoiceAEdit: TEdit; + ChoiceDEdit: TEdit; + ChoiceEEdit: TEdit; + ChoiceCEdit: TEdit; + ChoiceBEdit: TEdit; + CodeBrowseBtn: TButton; + GroupBox1: TGroupBox; + Memo1: TLabel; + NoChoicesEdit: TEdit; + Image1: TImage; + ItemCodeLabel: TLabel; + ItemSaveBtn: TButton; + ItemStemEdit: TEdit; + ItemStemLabel: TLabel; + jpegBrowseBtn: TButton; + jpeglabel: TLabel; + jpegnameEdit: TEdit; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Label7: TLabel; + MajorCodeEdit: TEdit; + MinorCodeEdit: TEdit; + MinorCodeLabel: TLabel; + OpenPictureDialog1: TOpenPictureDialog; + PreviousBtn: TButton; + ReturnBtn: TButton; + SelectImageBtn: TButton; + ShowNextBtn: TButton; + StartNewBtn: TButton; + ItemNoEdit: TEdit; + TFItemNoLabel: TLabel; + procedure CodeBrowseBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ItemSaveBtnClick(Sender: TObject); + procedure jpegBrowseBtnClick(Sender: TObject); + procedure NoChoicesEditChange(Sender: TObject); + procedure PreviousBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure SelectImageBtnClick(Sender: TObject); + procedure ShowNextBtnClick(Sender: TObject); + procedure StartNewBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + MCItemForm: TMCItemForm; + +implementation + +uses + ItemBankingUnit; + +{ TMCItemForm } + +procedure TMCItemForm.jpegBrowseBtnClick(Sender: TObject); +VAR + JPEG : TJPEGImage; +begin + OpenPictureDialog1.Options := OpenPictureDialog1.Options+[ofFileMustExist]; + if not OpenPictureDialog1.Execute then exit; + try + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(OpenPictureDialog1.FileName); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + end; + except + on E: Exception do begin + Image1.Picture.Clear; + MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0); + end; + end; + Image1.Proportional := true; +end; + +procedure TMCItemForm.NoChoicesEditChange(Sender: TObject); +var + nochoices : integer; +begin + nochoices := StrToInt(NoChoicesEdit.Text); + if nochoices > 0 then ChoiceAEdit.Visible := true else ChoiceAEdit.Visible := false; + if nochoices > 1 then ChoiceBEdit.Visible := true else ChoiceBEdit.Visible := false; + if nochoices > 2 then ChoiceCEdit.Visible := true else ChoiceCEdit.Visible := false; + if nochoices > 3 then ChoiceDEdit.Visible := true else ChoiceDEdit.Visible := false; + if nochoices > 4 then ChoiceEEdit.Visible := true else ChoiceEEdit.Visible := false; +end; + +procedure TMCItemForm.PreviousBtnClick(Sender: TObject); +Var + response : string; + itemno : integer; + JPEG : TJPEGImage; + nochoices : integer; +begin + response := InputBox('Save current item?','Save','Y'); + if response = 'Y' then ItemSaveBtnClick(self); + Image1.Canvas.Clear; + ChoiceAEdit.Text := ''; + ChoiceBEdit.Text := ''; + ChoiceCEdit.Text := ''; + ChoiceDEdit.Text := ''; + ChoiceEEdit.Text := ''; + response := InputBox('Code Number:','Number:','1'); + itemno := StrToInt(response); + if itemno <= ItemBankFrm.BankInfo.NMCItems then + begin + nochoices := ItemBankFrm.MCItemInfo[itemno].NoChoices; + ItemNoEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[itemno].ItemNumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[itemno].majorcode); + MinorCodeEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[itemno].minorcode); + NoChoicesEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[itemno].NoChoices); + ItemStemEdit.Text := ItemBankFrm.MCItemInfo[itemno].ItemStem ; + if nochoices > 0 then ChoiceAEdit.Text := ItemBankFrm.MCItemInfo[itemno].ChoiceOne; + if nochoices > 1 then ChoiceBEdit.Text := ItemBankFrm.MCItemInfo[itemno].ChoiceTwo; + if nochoices > 2 then ChoiceCEdit.Text := ItemBankFrm.MCItemInfo[itemno].ChoiceThree; + if nochoices > 3 then ChoiceDEdit.Text := ItemBankFrm.MCItemInfo[itemno].ChoiceFour; + if nochoices > 4 then ChoiceEEdit.Text := ItemBankFrm.MCItemInfo[itemno].ChoiceFive; + AnswerEdit.Text := ItemBankFrm.MCItemInfo[itemno].CorrectChoice; + jpegnameEdit.Text := ItemBankFrm.MCItemInfo[itemno].PicName; + if jpegnameEdit.Text <> 'none' then + begin + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(jpegnameEdit.Text); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + Image1.Proportional := true; + end; + end; + end; +end; + +procedure TMCItemForm.ReturnBtnClick(Sender: TObject); +begin + MCItemForm.Hide; + Close; +end; + +procedure TMCItemForm.ItemSaveBtnClick(Sender: TObject); +var + currentno : integer; + count : integer; + nochoices : integer; +begin + count := ItemBankFrm.BankInfo.NMCItems; + currentno := StrToInt(ItemNoEdit.Text); + if currentno > count then + begin + ItemBankFrm.BankInfo.NMCItems := currentno; + ItemBankFrm.NMCItemsText.Text := IntToStr(currentno); + end; + nochoices := StrToInt(NoChoicesEdit.Text); + ItemBankFrm.MCItemInfo[currentno].ItemNumber := currentno; + ItemBankFrm.MCItemInfo[currentno].majorcode := StrToInt(MajorCodeEdit.Text); + ItemBankFrm.MCItemInfo[currentno].minorcode := StrToInt(MinorCodeEdit.Text); + ItemBankFrm.MCItemInfo[currentno].NoChoices := nochoices; + ItemBankFrm.MCItemInfo[currentno].ItemStem := ItemStemEdit.Text; + if nochoices > 0 then ItemBankFrm.MCItemInfo[currentno].ChoiceOne := ChoiceAEdit.Text; + if nochoices > 1 then ItemBankFrm.MCItemInfo[currentno].ChoiceTwo := ChoiceBEdit.Text; + if nochoices > 2 then ItemBankFrm.MCItemInfo[currentno].ChoiceThree := ChoiceCEdit.Text; + if nochoices > 3 then ItemBankFrm.MCItemInfo[currentno].ChoiceFour := ChoiceDEdit.Text; + if nochoices > 4 then ItemBankFrm.MCItemInfo[currentno].ChoiceFive := ChoiceEEdit.Text; + ItemBankFrm.MCItemInfo[currentno].CorrectChoice := AnswerEdit.Text[1]; + ItemBankFrm.MCItemInfo[currentno].PicName := jpegnameEdit.Text; +end; + +procedure TMCItemForm.FormShow(Sender: TObject); +Var + JPEG : TJPEGImage; + nochoices : integer; +begin + ChoiceAEdit.Text := ''; + ChoiceBEdit.Text := ''; + ChoiceCEdit.Text := ''; + ChoiceDEdit.Text := ''; + ChoiceEEdit.Text := ''; + Image1.Canvas.Clear; + if ItemBankFrm.BankInfo.NMCItems > 0 then + begin + ItemNoEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[1].ItemNumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[1].majorcode) ; + MinorCodeEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[1].minorcode); + nochoices := ItemBankFrm.MCItemInfo[1].NoChoices; + NoChoicesEdit.Text := IntToStr(nochoices); + ItemStemEdit.Text := ItemBankFrm.MCItemInfo[1].ItemStem; + AnswerEdit.Text := ItemBankFrm.MCItemInfo[1].CorrectChoice; + if nochoices > 0 then ChoiceAEdit.Text := ItemBankFrm.MCItemInfo[1].ChoiceOne; + if nochoices > 1 then ChoiceBEdit.Text := ItemBankFrm.MCItemInfo[1].ChoiceTwo; + if nochoices > 2 then ChoiceCEdit.Text := ItemBankFrm.MCItemInfo[1].ChoiceThree; + if nochoices > 3 then ChoiceDEdit.Text := ItemBankFrm.MCItemInfo[1].ChoiceFour; + if nochoices > 4 then ChoiceEEdit.Text := ItemBankFrm.MCItemInfo[1].ChoiceFive; + jpegnameEdit.Text := ItemBankFrm.MCItemInfo[1].PicName; + if (jpegnameEdit.Text <> 'none') and FileExists(jpegnameEdit.Text) then + begin + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(jpegnameEdit.Text); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + Image1.Proportional := true; + end; + end else + Image1.Picture.Clear; + end else + begin + ItemNoEdit.Text := '1'; + MajorCodeEdit.Text := '1'; + MinorCodeEdit.Text := '0'; + ItemStemEdit.Text := ''; + AnswerEdit.Text := ''; + jpegnameEdit.Text := 'none'; + Image1.Picture.Clear; + end; +end; + +procedure TMCItemForm.CodeBrowseBtnClick(Sender: TObject); +var + count : integer; + i : integer; + outline : string; + nochoices : integer; +begin + OutputFrm.RichEdit.Clear; + count := ItemBankFrm.BankInfo.NMCItems; + OutputFrm.RichEdit.Lines.Add('Current Items'); + OutputFrm.RichEdit.Lines.Add(''); + + for i := 1 to count do + begin + ChoiceAEdit.Text := ''; + ChoiceBEdit.Text := ''; + ChoiceCEdit.Text := ''; + ChoiceDEdit.Text := ''; + ChoiceEEdit.Text := ''; + nochoices := ItemBankFrm.MCItemInfo[i].NoChoices; + outline := format('Item number %3d',[ItemBankFrm.MCItemInfo[i].itemnumber]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Major Code %3d',[ItemBankFrm.MCItemInfo[i].majorcode]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Minor Code %3d',[ItemBankFrm.MCItemInfo[i].minorcode]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('No. of Choices %3d',[ItemBankFrm.MCItemInfo[i].NoChoices]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Item Stem %s',[ItemBankFrm.MCItemInfo[i].ItemStem]); + OutputFrm.RichEdit.Lines.Add(outline); + if nochoices > 0 then + begin + outline := format('Choice A %s',[ItemBankFrm.MCItemInfo[i].ChoiceOne]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if nochoices > 1 then + begin + outline := format('Choice B %s',[ItemBankFrm.MCItemInfo[i].ChoiceTwo]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if nochoices > 2 then + begin + outline := format('Choice C %s',[ItemBankFrm.MCItemInfo[i].ChoiceThree]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if nochoices > 3 then + begin + outline := format('Choice D %s',[ItemBankFrm.MCItemInfo[i].ChoiceFour]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if nochoices > 4 then + begin + outline := format('Choice E %s',[ItemBankFrm.MCItemInfo[i].ChoiceFive]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := format('Correct Choice %s',[ItemBankFrm.MCItemInfo[i].CorrectChoice]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Graphic Image %s',[ItemBankFrm.MCItemInfo[i].PicName]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + end; + OutputFrm.ShowModal; +end; + +procedure TMCItemForm.FormActivate(Sender: TObject); +begin + if FAutoSized then + exit; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + FAutoSized := true; +end; + +procedure TMCItemForm.FormCreate(Sender: TObject); +begin + Assert(ItemBankFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TMCItemForm.SelectImageBtnClick(Sender: TObject); +begin + jpegnameEdit.Text := OpenPictureDialog1.FileName; +end; + +procedure TMCItemForm.ShowNextBtnClick(Sender: TObject); +var + count : integer; + itemno : integer; + JPEG : TJPEGImage; + nochoices : integer; + response : string; +begin + response := InputBox('Save current item?','Save','Y'); + if response = 'Y' then ItemSaveBtnClick(self); + Image1.Canvas.Clear; + itemno := StrToInt(ItemNoEdit.Text) + 1; + count := ItemBankFrm.BankInfo.NMCItems; + if count <= itemno then + begin + ChoiceAEdit.Text := ''; + ChoiceBEdit.Text := ''; + ChoiceCEdit.Text := ''; + ChoiceDEdit.Text := ''; + ChoiceEEdit.Text := ''; + nochoices := ItemBankFrm.MCItemInfo[itemno].NoChoices; + ItemNoEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[itemno].ItemNumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[itemno].majorcode) ; + MinorCodeEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[itemno].minorcode); + ItemStemEdit.Text := ItemBankFrm.MCItemInfo[itemno].ItemStem; + if nochoices > 0 then ChoiceAEdit.Text := ItemBankFrm.MCItemInfo[itemno].ChoiceOne; + if nochoices > 1 then ChoiceBEdit.Text := ItemBankFrm.MCItemInfo[itemno].ChoiceTwo; + if nochoices > 2 then ChoiceCEdit.Text := ItemBankFrm.MCItemInfo[itemno].ChoiceThree; + if nochoices > 3 then ChoiceDEdit.Text := ItemBankFrm.MCItemInfo[itemno].ChoiceFour; + if nochoices > 4 then ChoiceEEdit.Text := ItemBankFrm.MCItemInfo[itemno].ChoiceFive; + AnswerEdit.Text := ItemBankFrm.MCItemInfo[itemno].CorrectChoice; + jpegnameEdit.Text := ItemBankFrm.MCItemInfo[itemno].PicName; + if (jpegnameEdit.Text <> 'none') and FileExists(jpegnameEdit.Text) then + begin + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(jpegnameEdit.Text); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + Image1.Proportional := true; + end; + end else + Image1.Picture.Clear; + end; +end; + +procedure TMCItemForm.StartNewBtnClick(Sender: TObject); +var + currentno : integer; + response : string; +begin + response := InputBox('Save current item?','Save','Y'); + if response = 'Y' then ItemSaveBtnClick(self); + currentno := ItemBankFrm.BankInfo.NMCItems + 1; + ItemNoEdit.Text := IntToStr(currentno); + currentno := StrToInt(MinorCodeEdit.Text); + MinorCodeEdit.Text := IntToStr(currentno + 1); + NoChoicesEdit.Text := '0'; + ItemStemEdit.Text := ''; + ChoiceAEdit.Text := ''; + ChoiceBEdit.Text := ''; + ChoiceCEdit.Text := ''; + ChoiceDEdit.Text := ''; + ChoiceEEdit.Text := ''; + AnswerEdit.Text := ''; + jpegnameEdit.Text := 'none'; + Image1.Picture.Clear; +end; + +initialization + {$I mcitemunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.lfm new file mode 100644 index 000000000..db583bf6a --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.lfm @@ -0,0 +1,374 @@ +object TestSpecsForm: TTestSpecsForm + Left = 496 + Height = 574 + Top = 192 + Width = 965 + Caption = 'Test Specification' + ClientHeight = 574 + ClientWidth = 965 + OnShow = FormShow + LCLVersion = '2.1.0.0' + object ReturnBtn: TButton + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 896 + Height = 25 + Top = 541 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + OnClick = ReturnBtnClick + TabOrder = 0 + end + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = SpecFileEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 12 + Width = 130 + BorderSpacing.Left = 8 + Caption = 'Specification File Name: ' + ParentColor = False + end + object SpecFileEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + Left = 146 + Height = 23 + Top = 8 + Width = 393 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 1 + Text = 'SpecFileEdit' + end + object SelectChoiceBox: TCheckGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 114 + Top = 70 + Width = 204 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Selection Options:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 94 + ClientWidth = 200 + Items.Strings = ( + 'Multiple Choice items' + 'True or False items' + 'Essay items' + 'Matching items' + ) + OnItemClick = SelectChoiceBoxItemClick + TabOrder = 2 + Data = { + 0400000002020202 + } + end + object TFItemNoLabel: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrCenter + Left = 228 + Height = 15 + Top = 43 + Width = 74 + Caption = 'Item Number:' + ParentColor = False + end + object ItemNoEdit: TEdit + AnchorSideLeft.Control = TFItemNoLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SpecFileEdit + AnchorSideTop.Side = asrBottom + Left = 310 + Height = 23 + Top = 39 + Width = 44 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 3 + Text = '1' + end + object ItemCodeLabel: TLabel + AnchorSideLeft.Control = ItemNoEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SelectedEdit + AnchorSideTop.Side = asrCenter + Left = 370 + Height = 15 + Top = 43 + Width = 92 + BorderSpacing.Left = 16 + Caption = 'Item Major Code:' + ParentColor = False + end + object MajorCodeEdit: TEdit + AnchorSideLeft.Control = ItemCodeLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrCenter + Left = 470 + Height = 23 + Top = 39 + Width = 41 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 4 + Text = '1' + end + object MinorCodeLabel: TLabel + AnchorSideLeft.Control = MajorCodeEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SelectedEdit + AnchorSideTop.Side = asrCenter + Left = 527 + Height = 15 + Top = 43 + Width = 93 + BorderSpacing.Left = 16 + Caption = 'Item Minor Code:' + ParentColor = False + end + object MinorCodeEdit: TEdit + AnchorSideLeft.Control = MinorCodeLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrCenter + Left = 628 + Height = 23 + Top = 39 + Width = 45 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 5 + Text = '0' + end + object Panel1: TPanel + AnchorSideLeft.Control = GroupBox1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 228 + Height = 463 + Top = 70 + Width = 729 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + BorderStyle = bsSingle + TabOrder = 6 + end + object SelectItemBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 228 + Height = 25 + Top = 541 + Width = 106 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Bottom = 8 + Caption = 'Select this item' + OnClick = SelectItemBtnClick + TabOrder = 7 + end + object SkipBtn: TButton + AnchorSideLeft.Control = SelectItemBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 346 + Height = 25 + Top = 541 + Width = 97 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Bottom = 8 + Caption = 'Skip this item' + OnClick = SkipBtnClick + TabOrder = 8 + end + object Label7: TLabel + AnchorSideLeft.Control = MinorCodeEdit + AnchorSideLeft.Side = asrBottom + Left = 689 + Height = 15 + Top = 45 + Width = 54 + BorderSpacing.Left = 16 + Caption = 'Item Type:' + ParentColor = False + end + object SelectedEdit: TEdit + AnchorSideLeft.Control = Label7 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemNoEdit + Left = 751 + Height = 23 + Top = 39 + Width = 183 + BorderSpacing.Left = 8 + TabOrder = 9 + Text = 'SelectedEdit' + end + object Label8: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = NoItemsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NoItemsEdit + Left = 8 + Height = 15 + Top = 356 + Width = 150 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + Caption = 'Current no. items specified: ' + ParentColor = False + WordWrap = True + end + object NoItemsEdit: TEdit + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = SelectChoiceBox + AnchorSideRight.Side = asrBottom + Left = 166 + Height = 23 + Top = 352 + Width = 46 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + TabOrder = 10 + Text = 'NoItemsEdit' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = SelectChoiceBox + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 136 + Top = 200 + Width = 204 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + Caption = 'Number of Items of a Given Type' + ChildSizing.LeftRightSpacing = 14 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 8 + ChildSizing.VerticalSpacing = 4 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 116 + ClientWidth = 200 + TabOrder = 11 + object Label4: TLabel + Left = 14 + Height = 23 + Top = 6 + Width = 84 + Caption = 'Multiple Choice' + ParentColor = False + end + object MCNoEdit: TEdit + Left = 106 + Height = 23 + Top = 6 + Width = 80 + TabOrder = 0 + Text = 'Edit1' + end + object Label3: TLabel + Left = 14 + Height = 23 + Top = 33 + Width = 84 + Caption = 'True or False' + ParentColor = False + end + object TFNoEdit: TEdit + Left = 106 + Height = 23 + Top = 33 + Width = 80 + TabOrder = 1 + Text = 'TFNoEdit' + end + object Label5: TLabel + Left = 14 + Height = 23 + Top = 60 + Width = 84 + Caption = 'Matching' + ParentColor = False + end + object MatchNoEdit: TEdit + Left = 106 + Height = 23 + Top = 60 + Width = 80 + TabOrder = 2 + Text = 'Edit1' + end + object Label6: TLabel + Left = 14 + Height = 23 + Top = 87 + Width = 84 + Caption = 'Essay' + ParentColor = False + end + object EssayNoEdit: TEdit + Left = 106 + Height = 23 + Top = 87 + Width = 80 + TabOrder = 3 + Text = 'Edit1' + end + end + object OpenDialog1: TOpenDialog + left = 256 + top = 160 + end + object SaveDialog1: TSaveDialog + left = 256 + top = 88 + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.pas new file mode 100644 index 000000000..3fd7524bf --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/testspecsunit.pas @@ -0,0 +1,300 @@ +unit TestSpecsUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls; + +type + + { TTestSpecsForm } + + TTestSpecsForm = class(TForm) + GroupBox1: TGroupBox; + NoItemsEdit: TEdit; + Label8: TLabel; + SelectedEdit: TEdit; + Label7: TLabel; + SkipBtn: TButton; + SelectItemBtn: TButton; + ItemCodeLabel: TLabel; + ItemNoEdit: TEdit; + MajorCodeEdit: TEdit; + MinorCodeEdit: TEdit; + MinorCodeLabel: TLabel; + Panel1: TPanel; + TFItemNoLabel: TLabel; + TFNoEdit: TEdit; + EssayNoEdit: TEdit; + MatchNoEdit: TEdit; + MCNoEdit: TEdit; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + SelectChoiceBox: TCheckGroup; + SpecFileEdit: TEdit; + Label1: TLabel; + OpenDialog1: TOpenDialog; + ReturnBtn: TButton; + SaveDialog1: TSaveDialog; + procedure FormShow(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure SelectItemBtnClick(Sender: TObject); + procedure SelectChoiceBoxItemClick(Sender: TObject; Index: integer); + procedure SkipBtnClick(Sender: TObject); + procedure ShowMCItem(Sender: TObject; index : integer); + procedure ShowTFItem(Sender: TObject; index : integer); + procedure ShowEssayItem(Sender: TObject; index : integer); + procedure ShowMatchItem(Sender: TObject; index : integer); + private + { private declarations } + public + { public declarations } + testno : integer; + end; + +var + TestSpecsForm: TTestSpecsForm; + +implementation + +uses + ItemBankingUnit; + +{ TTestSpecsForm } + +procedure TTestSpecsForm.ReturnBtnClick(Sender: TObject); +begin + ItemBankFrm.BankInfo.TestItems := testno; + ItemBankFrm.NSpecifiedEdit.Text := IntToStr(testno); + TestSpecsForm.Hide; + Close; +end; + +procedure TTestSpecsForm.SelectItemBtnClick(Sender: TObject); +begin + testno := testno + 1; + ItemBankFrm.TestContents[testno].ItemNumber := StrToInt(ItemNoEdit.Text); + ItemBankFrm.TestContents[testno].MajorCode := StrToInt(MajorCodeEdit.Text); + ItemBankFrm.TestContents[testno].MinorCode := StrToInt(MinorCodeEdit.Text); + ItemBankFrm.TestContents[testno].ItemType := SelectedEdit.Text; + NoItemsEdit.Text := IntToStr(testno); +end; + +procedure TTestSpecsForm.FormShow(Sender: TObject); +begin + testno := 0; + NoItemsEdit.Text := '0'; +end; + +procedure TTestSpecsForm.SelectChoiceBoxItemClick(Sender: TObject; Index: integer); +var + nomc, notf, nomatch, noessay, i : integer; + response : string; +begin + nomc := StrToInt(MCNoEdit.Text); + notf := StrToInt(TFNoEdit.Text); + nomatch := StrToInt(MatchNoEdit.Text); + noessay := StrToInt(EssayNoEdit.Text); + case Index of + 0 : begin // Select multiple choice items + SelectedEdit.Text := 'MC'; + for i := 1 to nomc do + begin + ShowMCItem(self,i); + response := InputBox('Add item to test','Add?','Y'); + if response = 'Y' then SelectItemBtnClick(self) else SkipBtnClick(self); + end; + end; + 1 : begin // Select true or false items + SelectedEdit.Text := 'TF'; + for i := 1 to notf do + begin + ShowTFItem(self,i); + response := InputBox('Add item to test','Add?','Y'); + if response = 'Y' then SelectItemBtnClick(self) else SkipBtnClick(self); + end; + end; + 2 : begin // Select Essay items + SelectedEdit.Text := 'Essay'; + for i := 1 to noessay do + begin + ShowEssayItem(self,i); + response := InputBox('Add item to test','Add?','Y'); + if response = 'Y' then SelectItemBtnClick(self) else SkipBtnClick(self); + end; + end; + 3 : begin // Select matching items + SelectedEdit.Text := 'Matching'; + for i := 1 to nomc do + begin + ShowMatchItem(self,i); + response := InputBox('Add item to test','Add?','Y'); + if response = 'Y' then SelectItemBtnClick(self) else SkipBtnClick(self); + end; + end; + end; +end; + +procedure TTestSpecsForm.SkipBtnClick(Sender: TObject); +begin + ShowMessage('Item skipped'); +end; +procedure TTestSpecsForm.ShowMCItem(Sender: TObject; index : integer); +var + outline : string; + nochoices : integer; + space : integer; +begin + Panel1.Canvas.Clear; + space := Panel1.Canvas.Height div 9; + ItemNoEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[index].itemnumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[index].MajorCode); + MinorCodeEdit.Text := IntToStr(ItemBankFrm.MCItemInfo[index].MinorCode); + outline := ItemBankFrm.MCItemInfo[index].ItemStem; + Panel1.Canvas.TextOut(1,space,outline); + nochoices := ItemBankFrm.MCItemInfo[index].NoChoices ; + if nochoices > 0 then + begin + outline := format('Choice A %s',[ItemBankFrm.MCItemInfo[index].ChoiceOne]); + Panel1.Canvas.TextOut(1,space*2,outline); + end; + if nochoices > 1 then + begin + outline := format('Choice B %s',[ItemBankFrm.MCItemInfo[index].ChoiceTwo]); + Panel1.Canvas.TextOut(1,space*3,outline); + end; + if nochoices > 2 then + begin + outline := format('Choice C %s',[ItemBankFrm.MCItemInfo[index].ChoiceThree]); + Panel1.Canvas.TextOut(1,space*4,outline); + end; + if nochoices > 3 then + begin + outline := format('Choice D %s',[ItemBankFrm.MCItemInfo[index].ChoiceFour]); + Panel1.Canvas.TextOut(1,space*5,outline); + end; + if nochoices > 4 then + begin + outline := format('Choice E %s',[ItemBankFrm.MCItemInfo[index].ChoiceFive]); + Panel1.Canvas.TextOut(1,space*6,outline); + end; + outline := format('Correct Choice %s',[ItemBankFrm.MCItemInfo[index].CorrectChoice]); + Panel1.Canvas.TextOut(1,space*7,outline); + outline := format('Graphic Image %s',[ItemBankFrm.MCItemInfo[index].PicName]); + Panel1.Canvas.TextOut(1,space*8,outline); +end; +procedure TTestSpecsForm.ShowTFItem(Sender: TObject; index : integer); +var + outline : string; + space : integer; +begin + Panel1.Canvas.Clear; + space := Panel1.Canvas.Height div 9; + ItemNoEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[index].itemnumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[index].MajorCode); + MinorCodeEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[index].MinorCode); + outline := ItemBankFrm.TFItemInfo[index].ItemStem; + Panel1.Canvas.TextOut(1,space,outline); + outline := ItemBankFrm.TFItemInfo[index].CorrectChoice ; + Panel1.Canvas.TextOut(1,space*2,outline); + outline := ItemBankFrm.TFItemInfo[index].PicName ; + Panel1.Canvas.TextOut(1,space*3,outline); +end; +procedure TTestSpecsForm.ShowEssayItem(Sender: TObject; index : integer); +var + outline : string; + space : integer; +begin + Panel1.Canvas.Clear; + space := Panel1.Canvas.Height div 9; + ItemNoEdit.Text := IntToStr(ItemBankFrm.EssayInfo[index].itemnumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.EssayInfo[index].MajorCode); + MinorCodeEdit.Text := IntToStr(ItemBankFrm.EssayInfo[index].MinorCode); + outline := ItemBankFrm.EssayInfo[index].ItemStem; + Panel1.Canvas.TextOut(1,space,outline); + outline := ItemBankFrm.EssayInfo[index].Answer ; + Panel1.Canvas.TextOut(1,space*2,outline); + outline := ItemBankFrm.EssayInfo[index].PicName ; + Panel1.Canvas.TextOut(1,space*3,outline); +end; +procedure TTestSpecsForm.ShowMatchItem(Sender: TObject; index : integer); +var + outline : string; + space : integer; + noleft, noright : integer; +begin + Panel1.Canvas.Clear; + noleft := ItemBankFrm.MatchInfo[index].NLeft; + noright := ItemBankFrm.MatchInfo[index].NRight; + space := Panel1.Canvas.Height div 13; + ItemNoEdit.Text := IntToStr(ItemBankFrm.MatchInfo[index].itemnumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.MatchInfo[index].MajorCode); + MinorCodeEdit.Text := IntToStr(ItemBankFrm.MatchInfo[index].MinorCode); + // do left and right stems + if noleft > 0 then + begin + outline := format('Left Item 1 %s',[ItemBankFrm.MatchInfo[index].Left1]); + Panel1.Canvas.TextOut(1,space,outline); + end; + if noright > 0 then + begin + outline := format(' Right Item 1 %s',[ItemBankFrm.MatchInfo[index].Right1]); + Panel1.Canvas.TextOut(1,space*2,outline); + end; + if noleft > 1 then + begin + outline := format('Left Item 2 %s',[ItemBankFrm.MatchInfo[index].Left2]); + Panel1.Canvas.TextOut(1,space*3,outline); + end; + if noright > 1 then + begin + outline := format(' Right Item 2 %s',[ItemBankFrm.MatchInfo[index].Right2]); + Panel1.Canvas.TextOut(1,space*4,outline); + end; + if noleft > 2 then + begin + outline := format('Left Item 3 %s',[ItemBankFrm.MatchInfo[index].Left3]); + Panel1.Canvas.TextOut(1,space*5,outline); + end; + if noright > 2 then + begin + outline := format(' Right Item 3 %s',[ItemBankFrm.MatchInfo[index].Right3]); + Panel1.Canvas.TextOut(1,space*6,outline); + end; + if noleft > 3 then + begin + outline := format('Left Item 4 %s',[ItemBankFrm.MatchInfo[index].Left4]); + Panel1.Canvas.TextOut(1,space*7,outline); + end; + if noright > 3 then + begin + outline := format(' Right Item 4 %s',[ItemBankFrm.MatchInfo[index].Right4]); + Panel1.Canvas.TextOut(1,space*8,outline); + end; + if noleft > 4 then + begin + outline := format('Left Item 5 %s',[ItemBankFrm.MatchInfo[index].Left5]); + Panel1.Canvas.TextOut(1,space*9,outline); + end; + if noright > 4 then + begin + outline := format(' Right Item 5 %s',[ItemBankFrm.MatchInfo[index].Right5]); + Panel1.Canvas.TextOut(1,space*10,outline); + end; + outline := ItemBankFrm.MatchInfo[index].CorrectChoice ; + Panel1.Canvas.TextOut(1,space*11,outline); + outline := ItemBankFrm.MatchInfo[index].PicName ; + Panel1.Canvas.TextOut(1,space*12,outline); + +end; + +initialization + {$I testspecsunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/tfitemunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/tfitemunit.lfm new file mode 100644 index 000000000..d040f0dcb --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/tfitemunit.lfm @@ -0,0 +1,351 @@ +object TFItemForm: TTFItemForm + Left = 568 + Height = 426 + Top = 123 + Width = 592 + AutoSize = True + Caption = 'True-False Item Development' + ClientHeight = 426 + ClientWidth = 592 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object TFItemNoLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 134 + Width = 94 + BorderSpacing.Left = 8 + Caption = 'T-F Item Number:' + ParentColor = False + end + object TFItemNoEdit: TEdit + AnchorSideLeft.Control = TFItemNoLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 110 + Height = 23 + Top = 130 + Width = 44 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 0 + Text = '1' + end + object ItemCodeLabel: TLabel + AnchorSideLeft.Control = TFItemNoEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 170 + Height = 15 + Top = 134 + Width = 92 + BorderSpacing.Left = 16 + Caption = 'Item Major Code:' + ParentColor = False + end + object MajorCodeEdit: TEdit + AnchorSideLeft.Control = ItemCodeLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 270 + Height = 23 + Top = 130 + Width = 41 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 1 + Text = '1' + end + object MinorCodeLabel: TLabel + AnchorSideLeft.Control = MajorCodeEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 327 + Height = 15 + Top = 134 + Width = 93 + BorderSpacing.Left = 16 + Caption = 'Item Minor Code:' + ParentColor = False + end + object MinorCodeEdit: TEdit + AnchorSideLeft.Control = MinorCodeLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CodeBrowseBtn + AnchorSideTop.Side = asrCenter + Left = 428 + Height = 23 + Top = 130 + Width = 45 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Right = 16 + TabOrder = 2 + Text = '0' + end + object CodeBrowseBtn: TButton + AnchorSideLeft.Control = MinorCodeEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 489 + Height = 25 + Top = 129 + Width = 96 + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = 'Browse Items' + OnClick = CodeBrowseBtnClick + TabOrder = 3 + end + object ItemStemLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ItemStemEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 165 + Width = 57 + BorderSpacing.Left = 8 + Caption = 'Item Stem:' + ParentColor = False + end + object ItemStemEdit: TEdit + AnchorSideLeft.Control = ItemStemLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = TFItemNoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 73 + Height = 23 + Top = 161 + Width = 511 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 4 + Text = 'ItemStemEdit' + end + object AnswerLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = AnswerEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 196 + Width = 82 + BorderSpacing.Left = 8 + Caption = 'Answer (T or F):' + ParentColor = False + end + object AnswerEdit: TEdit + AnchorSideLeft.Control = AnswerLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemStemEdit + AnchorSideTop.Side = asrBottom + Left = 98 + Height = 23 + Top = 192 + Width = 29 + Alignment = taCenter + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 5 + end + object jpeglabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = jpegnameEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 227 + Width = 224 + BorderSpacing.Left = 8 + Caption = 'jpeg photo to display prior to item (if any):' + ParentColor = False + end + object jpegnameEdit: TEdit + AnchorSideLeft.Control = jpeglabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = AnswerEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 240 + Height = 23 + Top = 223 + Width = 344 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 6 + Text = 'jpegnameEdit' + end + object jpegBrowseBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = jpegnameEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = SelectImageBtn + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 25 + Top = 262 + Width = 132 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + Caption = 'Browse jpeg Images' + OnClick = jpegBrowseBtnClick + TabOrder = 7 + end + object Image1: TImage + AnchorSideLeft.Control = jpegBrowseBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = jpegnameEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ShowNextBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 148 + Height = 164 + Top = 254 + Width = 172 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Center = True + Constraints.MinHeight = 160 + end + object SelectImageBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = jpegBrowseBtn + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 25 + Top = 311 + Width = 132 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 24 + Caption = 'Select Shown Image' + OnClick = SelectImageBtnClick + TabOrder = 10 + end + object ItemSaveBtn: TButton + AnchorSideLeft.Control = ShowNextBtn + AnchorSideTop.Control = jpegBrowseBtn + AnchorSideRight.Control = ShowNextBtn + AnchorSideRight.Side = asrBottom + Left = 328 + Height = 25 + Top = 262 + Width = 110 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + Caption = 'Save this item' + OnClick = ItemSaveBtnClick + TabOrder = 8 + end + object StartNewBtn: TButton + AnchorSideLeft.Control = PreviousBtn + AnchorSideTop.Control = ShowNextBtn + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 454 + Height = 25 + Top = 311 + Width = 130 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Start a new item' + OnClick = StartNewBtnClick + TabOrder = 12 + end + object ReturnBtn: TButton + AnchorSideLeft.Side = asrCenter + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Image1 + AnchorSideBottom.Side = asrBottom + Left = 515 + Height = 33 + Top = 385 + Width = 69 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.InnerBorder = 4 + Caption = 'Return' + OnClick = ReturnBtnClick + TabOrder = 13 + end + object PreviousBtn: TButton + AnchorSideTop.Control = ItemSaveBtn + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 454 + Height = 25 + Top = 262 + Width = 130 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Show Previous Item' + OnClick = PreviousBtnClick + TabOrder = 9 + end + object ShowNextBtn: TButton + AnchorSideTop.Control = SelectImageBtn + AnchorSideRight.Control = PreviousBtn + Left = 328 + Height = 25 + Top = 311 + Width = 110 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 16 + Caption = 'Show Next Item' + OnClick = ShowNextBtnClick + TabOrder = 11 + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 105 + Top = 8 + Width = 576 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Directions: To create a True or False item, you will need to enter the number of an item code which contains both a major code and a minor code. It is suggested you print all item codes from the options menu on the main procedure page of the item banking program. You can however, browse the item codes from this form. After you have selected an item code number, enter the item stem in the space provided. Your item can also include a jpeg picture prior to the presentation of the item on a test. To find the image, click the jpeg browse button until you see the image you wish to include. When that item is shown, click the Select button to save the name of the image file.' + ParentColor = False + WordWrap = True + end + object OpenPictureDialog1: TOpenPictureDialog + left = 240 + top = 280 + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/tfitemunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/tfitemunit.pas new file mode 100644 index 000000000..467a3ad08 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/item_banking/tfitemunit.pas @@ -0,0 +1,278 @@ +unit TFItemUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, ExtDlgs, OutputUnit; + +type + + { TTFItemForm } + + TTFItemForm = class(TForm) + Memo1: TLabel; + ShowNextBtn: TButton; + PreviousBtn: TButton; + ItemSaveBtn: TButton; + OpenPictureDialog1: TOpenPictureDialog; + StartNewBtn: TButton; + ReturnBtn: TButton; + SelectImageBtn: TButton; + Image1: TImage; + jpegBrowseBtn: TButton; + CodeBrowseBtn: TButton; + AnswerEdit: TEdit; + jpegnameEdit: TEdit; + ItemStemEdit: TEdit; + ItemStemLabel: TLabel; + AnswerLabel: TLabel; + jpeglabel: TLabel; + MinorCodeEdit: TEdit; + MinorCodeLabel: TLabel; + MajorCodeEdit: TEdit; + ItemCodeLabel: TLabel; + TFItemNoEdit: TEdit; + TFItemNoLabel: TLabel; + procedure CodeBrowseBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ItemSaveBtnClick(Sender: TObject); + procedure jpegBrowseBtnClick(Sender: TObject); + procedure PreviousBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure SelectImageBtnClick(Sender: TObject); + procedure ShowNextBtnClick(Sender: TObject); + procedure StartNewBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + TFItemForm: TTFItemForm; + +implementation +uses ItemBankingUnit; +{ TTFItemForm } + +procedure TTFItemForm.jpegBrowseBtnClick(Sender: TObject); +VAR + JPEG : TJPEGImage; +begin + OpenPictureDialog1.Options := OpenPictureDialog1.Options+[ofFileMustExist]; + if not OpenPictureDialog1.Execute then exit; + try + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(OpenPictureDialog1.FileName); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + end; + except + on E: Exception do begin + MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0); + end; + end; + Image1.Proportional := true; +end; + +procedure TTFItemForm.PreviousBtnClick(Sender: TObject); +Var + response : string; + itemno : integer; + JPEG : TJPEGImage; +begin + response := InputBox('Code Number:','Number:','1'); + itemno := StrToInt(response); + if itemno <= ItemBankFrm.BankInfo.NTFItems then + begin + TFItemNoEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[itemno].ItemNumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[itemno].majorcode); + MinorCodeEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[itemno].minorcode); + ItemStemEdit.Text := ItemBankFrm.TFItemInfo[itemno].ItemStem ; + AnswerEdit.Text := ItemBankFrm.TFItemInfo[itemno].CorrectChoice; + jpegnameEdit.Text := ItemBankFrm.TFItemInfo[itemno].PicName; + if (jpegnameEdit.Text <> 'none') and FileExists(jpegnameEdit.Text) then + begin + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(jpegnameEdit.Text); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + Image1.Proportional := true; + end; + end; + end; +end; + +procedure TTFItemForm.ReturnBtnClick(Sender: TObject); +begin + Close; +end; + +procedure TTFItemForm.ItemSaveBtnClick(Sender: TObject); +var + currentno : integer; + count : integer; +begin + count := ItemBankFrm.BankInfo.NTFItems; + currentno := StrToInt(TFItemNoEdit.Text); + if currentno > count then + begin + ItemBankFrm.BankInfo.NTFItems := currentno; + ItemBankFrm.NTFItemsText.Text := IntToStr(currentno); + end; + ItemBankFrm.TFItemInfo[currentno].ItemNumber := currentno; + ItemBankFrm.TFItemInfo[currentno].majorcode := StrToInt(MajorCodeEdit.Text); + ItemBankFrm.TFItemInfo[currentno].minorcode := StrToInt(MinorCodeEdit.Text); + ItemBankFrm.TFItemInfo[currentno].ItemStem := ItemStemEdit.Text; + ItemBankFrm.TFItemInfo[currentno].CorrectChoice := AnswerEdit.text[1]; + ItemBankFrm.TFItemInfo[currentno].PicName := jpegnameEdit.Text; +end; + +procedure TTFItemForm.CodeBrowseBtnClick(Sender: TObject); +var + count : integer; + i : integer; + outline : string; +begin + OutputFrm.RichEdit.Clear; + count := ItemBankFrm.BankInfo.NTFItems; + OutputFrm.RichEdit.Lines.Add('Current Items'); + OutputFrm.RichEdit.Lines.Add(''); + + for i := 1 to count do + begin + outline := format('Item number %3d',[ItemBankFrm.TFItemInfo[i].itemnumber]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Major Code %3d',[ItemBankFrm.TFItemInfo[i].majorcode]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Minor Code %3d',[ItemBankFrm.TFItemInfo[i].minorcode]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Item Stem %s',[ItemBankFrm.TFItemInfo[i].ItemStem]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Correct Choice %s',[ItemBankFrm.TFItemInfo[i].CorrectChoice]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Graphic Image %s',[ItemBankFrm.TFItemInfo[i].PicName]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + end; + OutputFrm.ShowModal; +end; + +procedure TTFItemForm.FormActivate(Sender: TObject); +begin + if FAutoSized then + exit; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + FAutoSized := true; +end; + +procedure TTFItemForm.FormCreate(Sender: TObject); +begin + Assert(ItemBankFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TTFItemForm.FormShow(Sender: TObject); +Var + nitems : integer; + JPEG : TJPEGImage; +begin + nitems := ItemBankFrm.BankInfo.NTFItems; + if nItems > 0 then + begin + TFItemNoEdit.Text := '1'; //IntToStr(ItemBankFrm.TFItemInfo[1].ItemNumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[1].majorcode) ; + MinorCodeEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[1].minorcode); + ItemStemEdit.Text := ItemBankFrm.TFItemInfo[1].ItemStem; + AnswerEdit.Text := ItemBankFrm.TFItemInfo[1].CorrectChoice; + jpegnameEdit.Text := ItemBankFrm.TFItemInfo[1].PicName; + if (jpegnameEdit.Text <> 'none') and FileExists(jpegNameEdit.Text) then + begin + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(jpegnameEdit.Text); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + Image1.Proportional := true; + end; + end else + Image1.Picture.Clear;; + end else + begin + TFItemNoEdit.Text := '1'; + MajorCodeEdit.Text := '1'; + MinorCodeEdit.Text := '0'; + ItemStemEdit.Text := ''; + AnswerEdit.Text := ''; + jpegnameEdit.Text := ''; + Image1.Picture.Clear; + end; +end; + +procedure TTFItemForm.SelectImageBtnClick(Sender: TObject); +begin + jpegnameEdit.Text := OpenPictureDialog1.FileName; +end; + +procedure TTFItemForm.ShowNextBtnClick(Sender: TObject); +var + count : integer; + itemno : integer; + JPEG : TJPEGImage; +begin + itemno := StrToInt(TFItemNoEdit.Text) + 1; + count := ItemBankFrm.BankInfo.NTFItems; + if count <= itemno then + begin + TFItemNoEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[itemno].ItemNumber); + MajorCodeEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[itemno].majorcode) ; + MinorCodeEdit.Text := IntToStr(ItemBankFrm.TFItemInfo[itemno].minorcode); + ItemStemEdit.Text := ItemBankFrm.TFItemInfo[itemno].ItemStem; + AnswerEdit.Text := ItemBankFrm.TFItemInfo[itemno].CorrectChoice; + jpegnameEdit.Text := ItemBankFrm.TFItemInfo[itemno].PicName; + if (jpegnameEdit.Text <> 'none') and FileExists(jpegNameEdit.Text) then + begin + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(jpegnameEdit.Text); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + Image1.Proportional := true; + end; + end; + end; +end; + +procedure TTFItemForm.StartNewBtnClick(Sender: TObject); +var + currentno : integer; +begin + currentno := ItemBankFrm.BankInfo.NTFItems + 1; + TFItemNoEdit.Text := IntToStr(currentno); + currentno := StrToInt(MinorCodeEdit.Text); + MinorCodeEdit.Text := IntToStr(currentno + 1); + ItemStemEdit.Text := ''; + AnswerEdit.Text := ''; + jpegnameEdit.Text := 'none'; + Image1.Canvas.Clear; +end; + +initialization + {$I tfitemunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/kr21unit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/kr21unit.lfm new file mode 100644 index 000000000..781a348bc --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/kr21unit.lfm @@ -0,0 +1,234 @@ +object KR21Frm: TKR21Frm + Left = 733 + Height = 227 + Top = 411 + Width = 289 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Kuder-Richarson #21' + ClientHeight = 227 + ClientWidth = 289 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CancelBtn + Left = 4 + Height = 25 + Top = 128 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + Left = 66 + Height = 25 + Top = 128 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 136 + Height = 25 + Top = 128 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 3 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 220 + Height = 25 + Top = 128 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 4 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 112 + Width = 289 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 34 + Height = 104 + Top = 8 + Width = 221 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 104 + ClientWidth = 221 + TabOrder = 0 + object Label1: TLabel + AnchorSideTop.Control = NoItemsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NoItemsEdit + Left = 2 + Height = 15 + Top = 4 + Width = 136 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Maximum Score Possible:' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = MeanEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = MeanEdit + Left = 15 + Height = 15 + Top = 31 + Width = 123 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Mean of he Test Scores:' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = StdDevEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = StdDevEdit + Left = 15 + Height = 15 + Top = 58 + Width = 123 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Std. Dev. of Test Scores:' + ParentColor = False + end + object Label4: TLabel + AnchorSideTop.Control = RelEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = RelEdit + Left = 0 + Height = 15 + Top = 85 + Width = 138 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'KR#21 Reliability Estimate:' + ParentColor = False + end + object NoItemsEdit: TEdit + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 146 + Height = 23 + Top = 0 + Width = 75 + Alignment = taRightJustify + Anchors = [akTop, akRight] + TabOrder = 0 + Text = 'NoItemsEdit' + end + object MeanEdit: TEdit + AnchorSideLeft.Control = NoItemsEdit + AnchorSideTop.Control = NoItemsEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 146 + Height = 23 + Top = 27 + Width = 75 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 1 + Text = 'Edit1' + end + object StdDevEdit: TEdit + AnchorSideLeft.Control = NoItemsEdit + AnchorSideTop.Control = MeanEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 146 + Height = 23 + Top = 54 + Width = 75 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 2 + Text = 'Edit1' + end + object RelEdit: TEdit + AnchorSideLeft.Control = NoItemsEdit + AnchorSideTop.Control = StdDevEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 146 + Height = 23 + Top = 81 + Width = 75 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 3 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/kr21unit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/kr21unit.pas new file mode 100644 index 000000000..13240bf3f --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/kr21unit.pas @@ -0,0 +1,90 @@ +unit KR21Unit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls; + +type + + { TKR21Frm } + + TKR21Frm = class(TForm) + Bevel1: TBevel; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + NoItemsEdit: TEdit; + MeanEdit: TEdit; + StdDevEdit: TEdit; + RelEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + KR21Frm: TKR21Frm; + +implementation + +{ TKR21Frm } + +uses + Math; + +procedure TKR21Frm.ResetBtnClick(Sender: TObject); +begin + NoItemsEdit.Text := ''; + MeanEdit.Text := ''; + StdDevEdit.Text := ''; + RelEdit.Text := ''; +end; + +procedure TKR21Frm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure TKR21Frm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TKR21Frm.ComputeBtnClick(Sender: TObject); +var + items, mean, stddev, rel : double; +begin + items := StrToFloat(NoItemsEdit.Text); + mean := StrToFloat(MeanEdit.Text); + stddev := StrToFloat(StdDevEdit.Text); + rel := (items / (items - 1.0)) * (1.0 - (mean * (items - mean))/ + (items * sqr(stddev))); + RelEdit.Text := FormatFloat('0.00000', rel); //FloatToStr(rel); +end; + +initialization + {$I kr21unit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/polydifunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/polydifunit.lfm new file mode 100644 index 000000000..83a56a64a --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/polydifunit.lfm @@ -0,0 +1,639 @@ +object PolyDIFFrm: TPolyDIFFrm + Left = 548 + Height = 413 + Top = 305 + Width = 631 + AutoSize = True + Caption = 'Polytomous Item DIF' + ClientHeight = 413 + ClientWidth = 631 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 334 + Height = 25 + Top = 380 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 400 + Height = 25 + Top = 380 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 4 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 474 + Height = 25 + Top = 380 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 562 + Height = 25 + Top = 380 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 6 + end + object HelpBtn: TButton + Tag = 138 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 271 + Height = 25 + Top = 380 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 2 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Panel3 + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 356 + Top = 8 + Width = 411 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 + BevelOuter = bvNone + ClientHeight = 356 + ClientWidth = 411 + Constraints.MinWidth = 400 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ItemsList + AnchorSideTop.Control = Panel1 + Left = 236 + Height = 15 + Top = 0 + Width = 76 + Caption = 'Items Selected' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = ItemsList + AnchorSideBottom.Control = GroupVarEdit + Left = 236 + Height = 15 + Top = 296 + Width = 94 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Grouping Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 339 + Top = 17 + Width = 174 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object ItemInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 191 + Height = 28 + Top = 25 + Width = 28 + BorderSpacing.Top = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ItemInBtnClick + Spacing = 0 + TabOrder = 1 + end + object ItemOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ItemInBtn + AnchorSideTop.Side = asrBottom + Left = 191 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ItemOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ItemOutBtn + AnchorSideTop.Side = asrBottom + Left = 182 + Height = 25 + Top = 89 + Width = 46 + AutoSize = True + BorderSpacing.Top = 4 + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 3 + end + object GrpInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = GrpOutBtn + Left = 191 + Height = 28 + Top = 288 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = GrpInBtnClick + Spacing = 0 + TabOrder = 5 + end + object GrpOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 191 + Height = 28 + Top = 320 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 8 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = GrpOutBtnClick + Spacing = 0 + TabOrder = 6 + end + object GroupVarEdit: TEdit + AnchorSideLeft.Control = ItemsList + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GrpOutBtn + AnchorSideBottom.Side = asrBottom + Left = 236 + Height = 23 + Top = 313 + Width = 175 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 12 + TabOrder = 7 + Text = 'GroupVarEdit' + end + object ItemsList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GrpInBtn + Left = 236 + Height = 247 + Top = 17 + Width = 175 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 24 + ItemHeight = 0 + TabOrder = 4 + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 364 + Width = 631 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel3: TPanel + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 435 + Height = 364 + Top = 0 + Width = 196 + Anchors = [akTop, akRight, akBottom] + AutoSize = True + BevelOuter = bvNone + ClientHeight = 364 + ClientWidth = 196 + TabOrder = 1 + object Label4: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = LevelsEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 12 + Width = 124 + Caption = 'No. of Grouping Levels:' + ParentColor = False + end + object Label11: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = LowScoreEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 191 + Width = 99 + Caption = 'Lowest Item Score:' + ParentColor = False + end + object Label12: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = HiScoreEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 218 + Width = 103 + Caption = 'Highest Item Score:' + ParentColor = False + end + object Label13: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = RefGrpEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 245 + Width = 122 + Caption = 'Reference Group Code:' + ParentColor = False + end + object Label14: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = TrgtGrpEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 272 + Width = 98 + Caption = 'Focal Group Code:' + ParentColor = False + end + object LevelsEdit: TEdit + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 140 + Height = 23 + Top = 8 + Width = 40 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + OnExit = LevelsEditExit + TabOrder = 0 + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = TrgtGrpEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 51 + Top = 303 + Width = 188 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 12 + Caption = 'Option:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ClientHeight = 31 + ClientWidth = 184 + TabOrder = 6 + object GraphChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 134 + Caption = 'Graph of Level Means' + Checked = True + State = cbChecked + TabOrder = 0 + end + end + object LowScoreEdit: TEdit + AnchorSideLeft.Control = LevelsEdit + AnchorSideTop.Control = GroupBox2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 140 + Height = 23 + Top = 187 + Width = 40 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + TabOrder = 2 + end + object HiScoreEdit: TEdit + AnchorSideLeft.Control = LowScoreEdit + AnchorSideTop.Control = LowScoreEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = LowScoreEdit + AnchorSideRight.Side = asrBottom + Left = 140 + Height = 23 + Top = 214 + Width = 40 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 3 + Text = 'Edit1' + end + object RefGrpEdit: TEdit + AnchorSideLeft.Control = LowScoreEdit + AnchorSideTop.Control = HiScoreEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = LowScoreEdit + AnchorSideRight.Side = asrBottom + Left = 140 + Height = 23 + Top = 241 + Width = 40 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 4 + Text = 'Edit1' + end + object TrgtGrpEdit: TEdit + AnchorSideLeft.Control = LowScoreEdit + AnchorSideTop.Control = RefGrpEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = LowScoreEdit + AnchorSideRight.Side = asrBottom + Left = 140 + Height = 23 + Top = 268 + Width = 40 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 5 + Text = 'Edit1' + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = LevelsEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 132 + Top = 43 + Width = 188 + AutoSize = True + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + Caption = 'Enter Bounds for Levels' + ClientHeight = 112 + ClientWidth = 184 + TabOrder = 1 + object Panel2: TPanel + Left = 8 + Height = 104 + Top = 0 + Width = 168 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 104 + ClientWidth = 168 + TabOrder = 0 + object Label6: TLabel + AnchorSideLeft.Control = LevelScroll + AnchorSideTop.Control = Panel2 + Left = 0 + Height = 15 + Top = 0 + Width = 31 + Caption = 'Down' + ParentColor = False + end + object Label7: TLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = LevelScroll + AnchorSideRight.Side = asrBottom + Left = 106 + Height = 15 + Top = 0 + Width = 15 + Anchors = [akTop, akRight] + Caption = 'Up' + ParentColor = False + end + object Label8: TLabel + AnchorSideLeft.Control = LevelNoEdit + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel2 + Left = 135 + Height = 15 + Top = 0 + Width = 27 + Caption = 'Level' + ParentColor = False + end + object Label9: TLabel + AnchorSideTop.Control = LowBoundEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LowBoundEdit + Left = 50 + Height = 15 + Top = 54 + Width = 70 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Lower Bound' + ParentColor = False + end + object Label10: TLabel + AnchorSideTop.Control = UpBoundEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = UpBoundEdit + Left = 50 + Height = 15 + Top = 85 + Width = 70 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Upper Bound' + ParentColor = False + end + object LevelScroll: TScrollBar + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = LevelNoEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LevelNoEdit + Left = 0 + Height = 18 + Top = 21 + Width = 121 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Right = 8 + Min = 1 + PageSize = 0 + Position = 1 + TabOrder = 0 + OnScroll = LevelScrollScroll + end + object LevelNoEdit: TEdit + AnchorSideTop.Control = Label8 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 129 + Height = 23 + Top = 19 + Width = 39 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + TabOrder = 1 + Text = 'LevelNoEdit' + end + object LowBoundEdit: TEdit + AnchorSideTop.Control = LevelNoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 128 + Height = 23 + Top = 50 + Width = 40 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + OnExit = LowBoundEditExit + TabOrder = 2 + Text = 'LowBoundEdit' + end + object UpBoundEdit: TEdit + AnchorSideTop.Control = LowBoundEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 128 + Height = 23 + Top = 81 + Width = 40 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + OnExit = UpBoundEditExit + TabOrder = 3 + Text = 'Edit1' + end + end + end + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/polydifunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/polydifunit.pas new file mode 100644 index 000000000..a91cded2b --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/polydifunit.pas @@ -0,0 +1,625 @@ +unit PolyDifUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, + MainUnit, Globals, OutputUnit, FunctionsLib, GraphLib, ContextHelpUnit; + +type + + { TPolyDIFFrm } + + TPolyDIFFrm = class(TForm) + Bevel1: TBevel; + GroupBox2: TGroupBox; + HelpBtn: TButton; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + LowScoreEdit: TEdit; + HiScoreEdit: TEdit; + RefGrpEdit: TEdit; + TrgtGrpEdit: TEdit; + GraphChk: TCheckBox; + GroupBox1: TGroupBox; + Label11: TLabel; + Label12: TLabel; + Label13: TLabel; + Label14: TLabel; + LowBoundEdit: TEdit; + UpBoundEdit: TEdit; + Label10: TLabel; + Label9: TLabel; + LevelNoEdit: TEdit; + Label6: TLabel; + Label7: TLabel; + Label8: TLabel; + LevelsEdit: TEdit; + ItemInBtn: TBitBtn; + ItemOutBtn: TBitBtn; + AllBtn: TBitBtn; + GrpInBtn: TBitBtn; + GrpOutBtn: TBitBtn; + GroupVarEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + ItemsList: TListBox; + Label3: TLabel; + Label4: TLabel; + LevelScroll: TScrollBar; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure CancelBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure GrpInBtnClick(Sender: TObject); + procedure GrpOutBtnClick(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ItemInBtnClick(Sender: TObject); + procedure ItemOutBtnClick(Sender: TObject); + procedure LevelScrollScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); + procedure LevelsEditExit(Sender: TObject); + procedure LowBoundEditExit(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure UpBoundEditExit(Sender: TObject); + private + { private declarations } + NoItems : integer; + FAutoSized: Boolean; + nocats : integer; + ColNoSelected : IntDyneVec; + ColLabels, RowLabels : StrDyneVec; + Ubounds : IntDyneVec; // upper and lower bounds of score groups + Lbounds : IntdyneVec; + + public + { public declarations } + end; + +var + PolyDIFFrm: TPolyDIFFrm; + +implementation + +uses + Math; + +{ TPolyDIFFrm } + +procedure TPolyDIFFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + ItemsList.Clear; + GroupVarEdit.Text := ''; + ItemInBtn.Enabled := true; + ItemOutBtn.Enabled := false; + AllBtn.Enabled := true; + GrpInBtn.Enabled := true; + GrpOutBtn.Enabled := false; +// MHChk.Checked := true; + RefGrpEdit.Text := ''; + TrgtGrpEdit.Text := ''; + LowScoreEdit.Text := ''; + HiScoreEdit.Text := ''; + LevelsEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + if NoVariables > 0 then LevelScroll.Max := NoVariables; + LevelNoEdit.Text := '1'; + LowBoundEdit.Text := '0'; + UpBoundEdit.Text := '2'; + LevelScroll.Min := 1; + LevelScroll.Position := 1; + //allocate space on heap + SetLength(ColLabels,NoVariables+1); + SetLength(RowLabels,NoVariables+1); + SetLength(ColNoSelected,NoVariables); + SetLength(Lbounds,NoVariables * 10); + SetLength(Ubounds,NoVariables * 10); +end; + +procedure TPolyDIFFrm.ReturnBtnClick(Sender: TObject); +begin + Ubounds := nil; + Lbounds := nil; + ColNoSelected := nil; + RowLabels := nil; + ColLabels := nil; + Close; +end; + +procedure TPolyDIFFrm.UpBoundEditExit(Sender: TObject); +VAR i : integer; +begin + i := StrToInt(LevelNoEdit.Text); + Ubounds[i-1] := StrToInt(UpBoundEdit.Text); + if i = StrToInt(LevelsEdit.Text) then + begin + ComputeBtn.SetFocus; + exit; + end; + LowBoundEdit.Text := IntToStr(Ubounds[i-1] + 1); + LowBoundEdit.SetFocus; +end; + +procedure TPolyDIFFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinHeight := Height; + Constraints.MinWidth := Width; + + FAutoSized := true; +end; + +procedure TPolyDIFFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TPolyDIFFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TPolyDIFFrm.GrpInBtnClick(Sender: TObject); +VAR index : integer; +begin + if VarList.ItemIndex < 0 then + begin + GrpInBtn.Enabled := false; + exit; + end; + index := VarList.ItemIndex; + GroupVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + GrpInBtn.Enabled := false; + GrpOutBtn.Enabled := true; +end; + +procedure TPolyDIFFrm.GrpOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(GroupVarEdit.Text); + GroupVarEdit.Text := ''; + GrpOutBtn.Enabled := false; + GrpInBtn.Enabled := true; +end; + +procedure TPolyDIFFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TPolyDIFFrm.ItemInBtnClick(Sender: TObject); +VAR i, index : integer; +begin + if VarList.ItemIndex < 0 then + begin + ItemInBtn.Enabled := false; + exit; + end; + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + ItemsList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + ItemOutBtn.Enabled := true; +end; + +procedure TPolyDIFFrm.ItemOutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := ItemsList.ItemIndex; + if index < 0 then + begin + ItemOutBtn.Enabled := false; + exit; + end; + VarList.Items.Add(ItemsList.Items.Strings[index]); + ItemsList.Items.Delete(index); + ItemInBtn.Enabled := true; +end; + +procedure TPolyDIFFrm.LevelScrollScroll(Sender: TObject; + ScrollCode: TScrollCode; var ScrollPos: Integer); +var + scrlpos : integer; + level : integer; +begin + level := StrToInt(LevelNoEdit.Text); + scrlpos := LevelScroll.Position; + if ((scrlpos > level) and (level <= StrToInt(LevelsEdit.Text))) then + begin + LevelNoEdit.Text := IntToStr(scrlpos); + LowBoundEdit.SetFocus; + exit; + end; + if scrlpos < level then + begin + level := scrlpos; + if level > 0 then + begin + LevelNoEdit.Text := IntToStr(level); + LowBoundEdit.Text := IntToStr(Lbounds[level-1]); + UpBoundEdit.Text := IntToStr(Ubounds[level-1]); + end; + LowBoundEdit.SetFocus; + end; +end; + +procedure TPolyDIFFrm.LevelsEditExit(Sender: TObject); +begin + LevelScroll.Max := StrToInt(LevelsEdit.Text); + LowBoundEdit.SetFocus; +end; + +procedure TPolyDIFFrm.LowBoundEditExit(Sender: TObject); +VAR i : integer; +begin + i := StrToInt(LevelNoEdit.Text); + Lbounds[i-1] := StrToInt(LowBoundEdit.Text); + UpBoundEdit.SetFocus; +end; + +procedure TPolyDIFFrm.CancelBtnClick(Sender: TObject); +begin + Ubounds := nil; + Lbounds := nil; + ColNoSelected := nil; + RowLabels := nil; + ColLabels := nil; + Close; +end; + +procedure TPolyDIFFrm.AllBtnClick(Sender: TObject); +VAR i : integer; +begin + if VarList.Items.Count < 1 then exit; + for i := 0 to VarList.Items.Count - 1 do + ItemsList.Items.Add(VarList.Items.Strings[i]); + VarList.Clear; + ItemInBtn.Enabled := false; + ItemOutBtn.Enabled := true; +end; + +procedure TPolyDIFFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k : integer; + itm, nolevels, level : integer; + grpvar : integer; + subjgrp : integer; + subjtot : integer; + value : integer; + cellstring : string; + title : string; + nsize : array [1..2] of integer; + FData : IntDyneCube; //no. of category values within item for focal group + RData : IntDyneCube; //no. of category values within item for reference group + TotData : IntDyneCube; // sum of the above two + t, Mf, Mb, Sf, Sb, Nb, Nf, df, d, Sd : DblDyneVec; + Zc, Vart, BigJ, SumE, SumV, Term1, MY, prob : double; + X, BigDnum, BigDden, BigD, BigDS, Zd, M2, E, VarE, Ti, dftot : double; + loscore, hiscore : integer; +begin + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Polytomous Item DIF Analysis adapted by Bill Miller from'); + OutputFrm.RichEdit.Lines.Add('Procedures for extending item bias detection techniques'); + OutputFrm.RichEdit.Lines.Add('by Catherine Welch and H.D. Hoover, 1993'); + OutputFrm.RichEdit.Lines.Add('Applied Measurement in Education 6(1), pages 1-19.'); + OutputFrm.RichEdit.Lines.Add(''); + + NoItems := ItemsList.Items.Count; + loscore := StrToInt(LowScoreEdit.Text); + hiscore := StrToInt(HiScoreEdit.Text); + nocats := hiscore - loscore + 1; // 0 to highest score + nolevels := StrToInt(LevelsEdit.Text); + SetLength(FData,NoItems,hiscore+10,nolevels+10); + SetLength(RData,NoItems,hiscore+10,nolevels+10); + SetLength(TotData,NoItems,hiscore+10,nolevels+10); + SetLength(t,nolevels); + SetLength(Mf,nolevels); + SetLength(Mb,nolevels); + SetLength(Sf,nolevels); + SetLength(Sb,nolevels); + SetLength(Nb,nolevels); + SetLength(Nf,nolevels); + SetLength(df,nolevels); + SetLength(d,nolevels); + SetLength(Sd,nolevels); + + for k := 1 to 2 do nsize[k] := 0; + + // get items to analyze and their labels + for i := 1 to NoItems do // items to analyze + begin + for j := 1 to NoVariables do // variables in grid + begin + cellstring := OS3MainFrm.DataGrid.Cells[j,0]; + if cellstring = ItemsList.Items.Strings[i-1] then + begin // matched - save info + ColNoSelected[i-1] := j; + ColLabels[i-1] := cellstring; + RowLabels[i-1] := cellstring; + end; // end match + end; // next j + end; // next i + ColLabels[NoItems] := 'TOTAL'; + RowLabels[NoItems] := 'TOTAL'; + + // get the variable number of the grouping code + grpvar := 0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = GroupVarEdit.Text then grpvar := i; + end; + if grpvar = 0 then + begin + ShowMessage('Error - No group variable found.'); + exit; + end; + + // read data (score group and items) + for i := 1 to NoCases do + begin + subjtot := 0; + // Get group (reference or target) + value := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[grpvar,i]))); + subjgrp := 0; + if value = StrToInt(RefGrpEdit.Text) then subjgrp := 1; // reference grp + if value = StrToInt(TrgtGrpEdit.Text) then subjgrp := 2; // target group + if subjgrp = 0 then + begin + ShowMessage('Error - Bad group code for a subject.'); + exit; + end; + nsize[subjgrp] := nsize[subjgrp] + 1; + + for j := 1 to NoItems do // get item score and subject total + begin + itm := ColNoSelected[j-1]; + value := Round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[itm,i]))); + subjtot := subjtot + value; + end; + + level := 0; + for k := 0 to NoLevels-1 do // get score level category + begin + if ((subjtot >= Lbounds[k]) and (subjtot <= Ubounds[k])) then + level := k; + end; + + for j := 1 to NoItems do // add to data + begin + itm := ColNoSelected[j-1]; + value := Round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[itm,i]))); + value := value - loscore; + if subjgrp = 1 then + RData[j-1,value,level] := RData[j-1,value,level] + 1 + else FData[j-1,value,level] := FData[j-1,value,level] + 1; + TotData[j-1,value,level] := TotData[j-1,value,level] + 1; + end; + end; // next case i + + // Show upper and lower bounds for score group bins + OutputFrm.RichEdit.Lines.Add('Conditioning Levels'); + OutputFrm.RichEdit.Lines.Add('Lower Upper'); + for i := 0 to nolevels-1 do + begin + cellstring := format('%5d %5d',[Lbounds[i],Ubounds[i]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + OutputFrm.RichEdit.Lines.Add(''); + + // obtain statistics and print frequency in categories for each item + for i := 1 to NoItems do + begin + OutputFrm.RichEdit.Lines.Add('Observed Category Frequencies'); + OutputFrm.RichEdit.Lines.Add('Item Group Level Category Number'); + Title := ' '; + for j := 0 to nocats-1 do Title := Title + format('%10d',[j+loscore]); + OutputFrm.RichEdit.Lines.Add(Title); + Zc := 0.0; + dftot := 0.0; + BigDnum := 0.0; + BigDden := 0.0; + M2 := 0.0; + SumE := 0.0; // second term of M2 numerator + SumV := 0.0; // denominator of M2 + Term1 := 0.0; // first term of M2 numerator + for k := 0 to nolevels-1 do + begin + Mf[k] := 0.0; + Mb[k] := 0.0; + Sf[k] := 0.0; + Sb[k] := 0.0; + t[k] := 0.0; + Nb[k] := 0.0; + Nf[k] := 0.0; + df[k] := 0.0; + d[k] := 0.0; + Sd[k] := 0.0; + VarE := 0.0; + E := 0.0; + Ti := 0.0; + MY := 0.0; + Title := format('%3d Ref. %3d',[i,k+1]); + for j := 0 to nocats-1 do + begin + Title := Title + format('%10d',[RData[i-1,j,k]]); + X := RData[i-1,j,k] * (j+loscore); + Mb[k] := Mb[k] + X; + Sb[k] := Sb[k] + (X * X); + Nb[k] := Nb[k] + RData[i-1,j,k]; + end; + OutputFrm.RichEdit.Lines.Add(Title); + Title := format('%3d Focal %3d',[i,k+1]); + for j := 0 to nocats-1 do + begin + Title := Title + format('%10d',[FData[i-1,j,k]]); + X := FData[i-1,j,k] * (j + loscore); + Mf[k] := Mf[k] + X; + Sf[k] := Sf[k] + (X * X); + Nf[k] := Nf[k] + FData[i-1,j,k]; + end; + OutputFrm.RichEdit.Lines.Add(Title); + Title := format('%3d Total %3d',[i,k+1]); + for j := 0 to nocats-1 do + Title := Title + format('%10d',[TotData[i-1,j,k]]); + OutputFrm.RichEdit.Lines.Add(Title); + OutputFrm.RichEdit.Lines.Add(''); + for j := 0 to nocats-1 do + begin + Term1 := Term1 + FData[i-1,j,k] * (j+loscore); + X := TotData[i-1,j,k] * (j+loscore); + E := E + X; + Ti := Ti + TotData[i-1,j,k]; + MY := MY + TotData[i-1,j,k] * (j + loscore); + VarE := VarE + TotData[i-1,j,k] * (j + loscore)*(j + loscore); + end; + E := E / Ti; + E := Nf[k] * E; + SumE := SumE + E; // second term of num. of m2 + VarE := (Ti * VarE) - (MY * MY); + VarE := ((Nf[k] * Nb[k]) / (Ti * Ti * (Ti - 1.0))) * VarE; + SumV := SumV + VarE; // den. of M2 + if (Nf[k] + Nb[k]) < 5 then continue; + Sf[k] := Sf[k] - (Mf[k] * Mf[k] / Nf[k]); + Sf[k] := Sf[k] / (Nf[k] - 1.0); + Sb[k] := Sb[k] - (Mb[k] * Mb[k] / Nb[k]); + Sb[k] := Sb[k] / (Nb[k] - 1.0); + Mf[k] := Mf[k] / Nf[k]; + Mb[k] := Mb[k] / Nb[k]; + t[k] := Mf[k] - Mb[k]; + df[k] := Nb[k] + Nf[k] - 2.0; + Vart := ((Sf[k] * Nf[k]) + (Sb[k] * Nb[k])) / df[k]; + Vart := sqrt(Vart * ((1.0 / Nf[k]) + (1.0 / Nb[k]))); + t[k] := t[k] / Vart; + Zc := Zc + t[k]; + dftot := dftot + (df[k] / (df[k] - 2.0)); + BigJ := 1.0 - (3.0 / (4.0 * df[k] - 1.0)); + d[k] := BigJ * sqrt((Nb[k] * Nf[k]) / (Nb[k] * Nf[k])); + d[k] := d[k] * t[k]; + Sd[k] := (BigJ * BigJ) * (df[k] / (df[k] - 2.0)); + Sd[k] := Sd[k] * (Nb[k] + Nf[k]) / (Nb[k] * Nf[k]); + Sd[k] := Sd[k] + (d[k] * d[k]) * ((BigJ * BigJ * df[k])/(df[k]-2.0) - 1.0); + BigDnum := BigDnum + d[k] / Sd[k]; + BigDden := BigDden + 1.0 / Sd[k]; + end; // next level k + M2 := (Term1 - SumE) * (Term1 - SumE) / SumV; + Title := 't-test values for Reference and Focus Means for each level'; + OutputFrm.RichEdit.Lines.Add(Title); + for k := 0 to nolevels-1 do + begin + Title := format('Mean Reference = %10.3f SD = %10.3f N = %5.0f',[Mb[k],sqrt(Sb[k]),Nb[k]]); + OutputFrm.RichEdit.Lines.Add(Title); + Title := format('Mean Focal = %10.3f SD = %10.3f N = %5.0f',[Mf[k],sqrt(Sf[k]),Nf[k]]); + OutputFrm.RichEdit.Lines.Add(Title); + Title := format('Level %3d t = %8.3f with deg. freedom = %5.0f',[k+1,t[k],df[k]]); + OutputFrm.RichEdit.Lines.Add(Title); + end; + Zc := Zc / dftot; // HW1 statistic + prob := 1.0 - probz(Zc); + Title := format('Composite z statistic = %6.3f. Prob. > |z| = %6.3f',[Zc, prob]); + OutputFrm.RichEdit.Lines.Add(Title); + BigD := BigDnum / BigDden; + BigDS := 1.0 / sqrt(BigDden); + Zd := BigD / BigDS; // HW3 statistic + prob := 1.0 - probz(Zd); + Title := format('Weighted Composite z statistic = %6.3f. Prob. > |z| = %6.3f',[Zd, prob]); + OutputFrm.RichEdit.Lines.Add(Title); + prob := 1.0 - chisquaredprob(M2,1); + Title := format('Generalized Mantel-Haenszel = %10.3f with D.F. = 1 and Prob. > Chi-Sqr. = %6.3f',[M2, prob]); + OutputFrm.RichEdit.Lines.Add(Title); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + if GraphChk.Checked then + begin + GraphFrm.nosets := 2; + GraphFrm.nbars := nolevels; + GraphFrm.Heading := 'Level Means'; + GraphFrm.XTitle := 'Level'; + GraphFrm.YTitle := 'Mean'; + SetLength(GraphFrm.Ypoints,2,nolevels+1); + SetLength(GraphFrm.Xpoints,1,nolevels+1); + for k := 0 to nolevels-1 do + begin + GraphFrm.Ypoints[0,k] := Mb[k]; + GraphFrm.Xpoints[0,k] := k+1; + GraphFrm.Ypoints[1,k] := Mf[k]; + end; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := true; + GraphFrm.GraphType := 2; // 3d Vertical Bar Chart + GraphFrm.ShowLeftWall := true; + GraphFrm.ShowRightWall := true; + GraphFrm.ShowBottomWall := true; + GraphFrm.ShowBackWall := true; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.ShowModal; + end; + end; // next item + + // clean up the heap + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + FData := nil; + RData := nil; + TotData := nil; + t := nil; + Mf := nil; + Mb := nil; + Sf := nil; + Sb := nil; + Nb := nil; + Nf := nil; + df := nil; + d := nil; + Sd:= nil; +end; + + +initialization + {$I polydifunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/raschunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/raschunit.lfm new file mode 100644 index 000000000..c42731bec --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/raschunit.lfm @@ -0,0 +1,272 @@ +object RaschFrm: TRaschFrm + Left = 673 + Height = 419 + Top = 319 + Width = 406 + AutoSize = True + Caption = 'Rasch One Parameter Item Scaling' + ClientHeight = 419 + ClientWidth = 406 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 36 + Height = 93 + Top = 277 + Width = 334 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Output Options:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 73 + ClientWidth = 330 + TabOrder = 4 + object ProxChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 179 + Caption = 'Show Prox Calculations' + TabOrder = 0 + end + object PlotItemsChk: TCheckBox + Left = 191 + Height = 19 + Top = 6 + Width = 127 + Caption = 'Plot Item Difficulties' + TabOrder = 1 + end + object PlotScrsChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 179 + Caption = 'Plot Log Abilities' + TabOrder = 2 + end + object ItemInfoChk: TCheckBox + Left = 191 + Height = 19 + Top = 27 + Width = 127 + Caption = 'Plot Item Functions' + TabOrder = 3 + end + object TestInfoChk: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 179 + Caption = 'Plot Test Information function' + TabOrder = 4 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 105 + Height = 25 + Top = 386 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 6 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 171 + Height = 25 + Top = 386 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 7 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 245 + Height = 25 + Top = 386 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 8 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 333 + Height = 25 + Top = 386 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 9 + end + object HelpBtn: TButton + Tag = 140 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 42 + Height = 25 + Top = 386 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 5 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 370 + Width = 406 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ItemList + AnchorSideTop.Control = Owner + Left = 225 + Height = 15 + Top = 8 + Width = 93 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Selected Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 244 + Top = 25 + Width = 173 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 189 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object ItemList: TListBox + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 225 + Height = 244 + Top = 25 + Width = 173 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 3 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 189 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/raschunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/raschunit.pas new file mode 100644 index 000000000..d978f9869 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/raschunit.pas @@ -0,0 +1,1296 @@ +unit RaschUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, GraphLib, Globals, + DataProcs, ContextHelpUnit; + +type + + { TRaschFrm } + + TRaschFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + ProxChk: TCheckBox; + PlotItemsChk: TCheckBox; + PlotScrsChk: TCheckBox; + ItemInfoChk: TCheckBox; + TestInfoChk: TCheckBox; + GroupBox1: TGroupBox; + InBtn: TBitBtn; + Label2: TLabel; + ItemList: TListBox; + OutBtn: TBitBtn; + Label1: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure ANALYZE(VAR itemfail : IntDyneVec; + VAR grpfail : IntDyneVec; + VAR f : IntDyneMat; + VAR T : integer; + VAR grppass : IntDyneVec; + VAR itempass : IntDyneVec; + r, C1 : integer; + VAR min : double; + VAR max : double; + VAR p2 : DblDyneVec); + procedure EXPAND(v1, v2 : double; + VAR xexpand : double; + VAR yexpand : double); + procedure FinishIt(r : integer; + VAR i5 : IntDyneVec; + VAR rptbis : DblDyneVec; + VAR rbis : DblDyneVec; + VAR slope : DblDyneVec; + VAR mean : DblDyneVec; + VAR itemfail : IntDyneVec; + VAR P : DblDyneVec ); + procedure FREQUENCIES(C1, r : integer; + VAR f : IntDyneMat; + VAR rowtot : IntDyneVec; + VAR i5 : IntDyneVec; + VAR s5 : IntDyneVec; + T : integer; + VAR S : IntDyneVec); + procedure GETLOGS(VAR L : DblDyneVec; + VAR L1 : DblDyneVec; + VAR L2 : DblDyneVec; + VAR g : DblDyneVec; + VAR g2 : DblDyneVec; + VAR f2 : DblDyneVec; + VAR rowtot : IntDyneVec; + k : integer; + VAR s5 : IntDyneVec; + VAR S : IntDyneVec; + T, r, C1 : integer; + VAR v1 : double; + VAR v2 : double); + procedure GETSCORES(VAR noselected : integer; + VAR selected : IntDyneVec; + NoCases : integer; + f : IntDyneMat; + VAR mean : DblDyneVec; + VAR xsqr : DblDyneVec; + VAR sumxy : DblDyneVec; + VAR S : IntDyneVec; + VAR X : IntDyneVec; + VAR sumx : double; + VAR sumx2 : double; + VAR N : integer); + procedure MAXABILITY(VAR expdcnt : DblDyneVec; + VAR d2 : DblDyneVec; + VAR e2 : DblDyneVec; + VAR p1 : DblDyneMat; + VAR p2 : DblDyneVec; + VAR P : DblDyneVec; + C1, r : integer; + D : DblDyneMat; + VAR s5 : IntDyneVec; + noloops : integer); + function MAXITEM(VAR R1 : DblDyneVec; + VAR d1 : DblDyneVec; + VAR p1 : DblDyneMat; + VAR D : DblDyneMat; + VAR e1 : DblDyneVec; + VAR p2 : DblDyneVec; + VAR P : DblDyneVec; + VAR S : IntDyneVec; + VAR rowtot : IntDyneVec; + T, r, C1 : integer) : double; + procedure MAXOUT(r, C1 : integer; + VAR i5 : IntDyneVec; + VAR s5 : IntDyneVec; + VAR P : DblDyneVec; + VAR p2 : DblDyneVec); + procedure PROX(VAR P : DblDyneVec; + VAR p2 : DblDyneVec; + k, r, C1 : integer; + VAR L1 : DblDyneVec; + yexpand, xexpand : double; + VAR g : DblDyneVec; + T : integer; + VAR rowtot : IntDyneVec; + VAR i5 : IntDyneVec; + VAR s5 : IntDyneVec); + Function REDUCE(k : integer; + VAR r : integer; + VAR T : integer; + VAR C1 : integer; + VAR i5 : IntDyneVec; + VAR rowtot : IntDyneVec; + VAR s5 : IntDyneVec; + VAR f : IntDyneMat; + VAR S : IntDyneVec) : integer; + procedure SLOPES(VAR rptbis : DblDyneVec; + VAR rbis : DblDyneVec; + VAR slope : DblDyneVec; + N : integer; + sumx, sumx2 : double; + VAR sumxy : DblDyneVec; + r : integer; + VAR xsqr : DblDyneVec; + VAR mean : DblDyneVec); + procedure TESTFIT(r, C1 : integer; + VAR f : IntDyneMat; + VAR S : IntDyneVec; + VAR P : DblDyneVec; + VAR p2 : DblDyneVec; + T : integer); + procedure PLOTINFO(k, r : integer; + VAR info : DblDyneMat; + VAR A : DblDyneMat; + VAR slope : DblDyneVec; + VAR P : DblDyneVec); + procedure plot(VAR xyarray : DblDyneMat; + arraysize : integer; + Title : string; + Vdivisions, Hdivisions : integer); + procedure PlotItems(r : integer; i5 : IntDyneVec; P : DblDyneVec); + procedure PlotScrs(C1 : integer; s5 : IntDyneVec; p2 : DblDyneVec); + procedure PlotTest(VAR TestInfo : DblDyneMat; + arraysize : integer; + Title : string; + Vdivisions, Hdivisions : integer); + public + { public declarations } + end; + +var + RaschFrm: TRaschFrm; + +implementation + +uses + Math; + +{ TRaschFrm } + +procedure TRaschFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + ItemList.Clear; + OutBtn.Enabled := false; + InBtn.Enabled := true; + ProxChk.Checked := false; + PlotItemsChk.Checked := false; + PlotScrsChk.Checked := false; + ItemInfoChk.Checked := false; + TestInfoChk.Checked := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TRaschFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TRaschFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TRaschFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TRaschFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TRaschFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k1, N, C1, r, T,noloops : integer; + sumx, sumx2, v1, v2, xexpand, yexpand, d9, min, max : double; + X, rowtot, itemfail, itempass, grpfail, grppass, S, s5, i5 : IntDyneVec; + f : IntDyneMat; + mean, xsqr, sumxy, L, L1, L2, g, g2, f2, P, p2, R1, d1, e1 : DblDyneVec; + expdcnt, d2 : DblDyneVec; + e2, rptbis, rbis, slope : DblDyneVec; + p1, D, info, A : DblDyneMat; + NoSelected : integer; + ColNoSelected : IntDyneVec; + finished : boolean; + cellstring : string; + error : integer; +begin + SetLength(ColNoSelected,NoVariables); + SetLength(mean,NoVariables); + SetLength(xsqr,NoVariables); + SetLength(sumxy,NoVariables); + SetLength(L,NoVariables); + SetLength(L1,NoVariables); + SetLength(L2,NoVariables); + SetLength(g,NoVariables); + SetLength(g2,NoVariables); + SetLength(f2,NoVariables); + SetLength(P,NoVariables); + SetLength(p2,NoVariables); + SetLength(R1,NoVariables); + SetLength(d1,NoVariables); + SetLength(e1,NoVariables); + SetLength(expdcnt,NoVariables); + SetLength(d2,NoVariables); + SetLength(e2,NoVariables); + SetLength(rptbis,NoVariables); + SetLength(rbis,NoVariables); + SetLength(slope,NoVariables); + SetLength(p1,NoVariables,NoVariables); + SetLength(D,NoVariables,NoVariables); + SetLength(info,52,52); + SetLength(A,52,2); + SetLength(X,NoVariables); + SetLength(rowtot,NoVariables); + SetLength(itemfail,NoVariables); + SetLength(itempass,NoVariables); + SetLength(grpfail,NoVariables); + SetLength(grppass,NoVariables); + SetLength(S,NoVariables+2); + SetLength(s5,NoVariables); + SetLength(i5,NoVariables); + SetLength(f,NoVariables+2,NoVariables+2); + if (NoVariables < 1) then + begin + ShowMessage('ERROR! You must have data in your data grid!'); + exit; + end; + + // Get selected variables + NoSelected := ItemList.Items.Count; + for i := 1 to NoSelected do + begin + for j := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[j,0]; + if cellstring = ItemList.Items.Strings[i-1] then + ColNoSelected[i-1] := j; + end; + end; + + //begin ( main program ) + finished := false; + N := NoCases; + k1 := NoSelected; + + GETSCORES(NoSelected, ColNoSelected, NoCases, f, mean, xsqr, sumxy, S, X, + sumx, sumx2, N); + error := REDUCE(k1, r, T, C1, i5, rowtot, s5, f, S); + if error = 1 then exit; + FREQUENCIES(C1, r, f, rowtot, i5, s5, T, S ); + v1 := 0.0; + v2 := 0.0; + GETLOGS(L, L1, L2, g, g2, f2, rowtot, k1, s5, S, T, r, C1, v1, v2); + EXPAND(v1, v2, xexpand, yexpand); + PROX(P, p2, k1, r, C1, L1, yexpand, xexpand, g, T, rowtot, i5, s5); + // start iterations for the maximum-liklihood (SetLengthton-Rhapson procedure) + // estimates + noloops := 0; + + while (not finished) do + begin + d9 := MAXITEM(R1, d1, p1, D, e1, p2, P, S, rowtot, T, r, C1); + if (d9 < 0.01) then finished := true + else MAXABILITY(expdcnt, d2, e2, p1, p2, P, C1, r, D, s5, noloops); + noloops := noloops + 1; + if (noloops > 25) then + begin + ShowMessage('WARNING! Maximum Liklihood failed to converge after 25 iterations'); + finished := true; + end; + end; + MAXOUT(r, C1, i5, s5, P, p2); + TESTFIT(r, C1, f, S, P, p2, T); + SLOPES(rptbis, rbis, slope, N, sumx, sumx2, sumxy, r, xsqr, mean); + ANALYZE(itemfail, grpfail, f, T, grppass, itempass, r, C1, min, max, p2); + if PlotItemsChk.Checked then PlotItems(r, i5, P); + if PlotScrsChk.Checked then PlotScrs(C1, s5, p2); + PLOTINFO(k1, r, info, A, slope, P); + FinishIt(r, i5, rptbis, rbis, slope, mean, itemfail, P); + + // cleanup + A := nil; + info := nil; + D := nil; + p1 := nil; + f := nil; + grppass := nil; + grpfail := nil; + itempass := nil; + itemfail := nil; + i5 := nil; + s5 := nil; + S := nil; + sumxy := nil; + xsqr := nil; + mean := nil; + rowtot := nil; + X := nil; + d1 := nil; + R1 := nil; + p2 := nil; + P := nil; + f2 := nil; + g2 := nil; + g := nil; + L2 := nil; + L1 := nil; + L := nil; + e1 := nil; + expdcnt := nil; + d2 := nil; + e2 := nil; + slope := nil; + rbis := nil; + rptbis := nil; + ColNoSelected := nil; +end; + +procedure TRaschFrm.InBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + ItemList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + OutBtn.Enabled := true; + +end; + +procedure TRaschFrm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := ItemList.ItemIndex; + if index < 0 then + begin + OutBtn.Enabled := false; + exit; + end; + VarList.Items.Add(ItemList.Items.Strings[index]); + ItemList.Items.Delete(index); +end; + +procedure TRaschFrm.ANALYZE(VAR itemfail : IntDyneVec; + VAR grpfail : IntDyneVec; + VAR f : IntDyneMat; + VAR T : integer; + VAR grppass : IntDyneVec; + VAR itempass : IntDyneVec; + r, C1 : integer; + VAR min : double; + VAR max : double; + VAR p2 : DblDyneVec); +var + i, j : integer; + +begin + for i := 0 to r-1 do itemfail[i] := 0; + for j := 0 to C1-1 do grpfail[j] := 0; + for i := 0 to r-1 do + begin + for j := 0 to C1-1 do + begin + grpfail[j] := grpfail[j] + f[i,j]; + itemfail[i] := itemfail[i] + f[i,j]; + end; + end; + T := 0; + for j := 0 to C1-1 do T := T + grpfail[j]; + for j := 0 to C1-1 do grppass[j] := T - grpfail[j]; + for i := 0 to r-1 do itempass[i] := T - itemfail[i]; + min := p2[0]; + max := p2[0]; + for i := 0 to C1-1 do + begin + if (p2[i] < min) then min := p2[i]; + if (p2[i] > max) then max := p2[i]; + end; +end; // End Sub 'end analyze procedure + +procedure TRaschFrm.EXPAND(v1, v2 : double; + VAR xexpand : double; + VAR yexpand : double); +begin + yexpand := sqrt( (1.0 + (v2 / 2.89)) / (1.0 - (v1 * v2 / 8.35)) ); + xexpand := sqrt( (1.0 + (v1 / 2.89)) / (1.0 - (v1 * v2 / 8.35)) ); +end; //End Sub 'end of expand + +procedure TRaschFrm.FinishIt(r : integer; + VAR i5 : IntDyneVec; + VAR rptbis : DblDyneVec; + VAR rbis : DblDyneVec; + VAR slope : DblDyneVec; + VAR mean : DblDyneVec; + VAR itemfail : IntDyneVec; + VAR P : DblDyneVec ); +var + i : integer; + outline : string; +begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Item Data Summary'); + OutputFrm.RichEdit.Lines.Add( 'ITEM PT.BIS.R. BIS.R. SLOPE PASSED FAILED RASCH DIFF'); + for i := 0 to r-1 do + begin + outline := format('%3d %6.3f %6.3f %5.2f %6.2f %4d %6.3f', + [i5[i],rptbis[i],rbis[i],slope[i],mean[i],itemfail[i],P[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.ShowModal; +end; // end FinishIt procedure + +procedure TRaschFrm.FREQUENCIES(C1, r : integer; + VAR f : IntDyneMat; + VAR rowtot : IntDyneVec; + VAR i5 : IntDyneVec; + VAR s5 : IntDyneVec; + T : integer; + VAR S : IntDyneVec); +var + i, j, c2, c3 : integer; + Done : boolean; + outline, strvalue : string; + +begin + Done := false; + c3 := C1; + c2 := 1; + if (c3 > 16) then c3 := 16; + while (not Done) do + begin + OutputFrm.RichEdit.Lines.Add('Matrix of Item Failures in Score Groups'); + outline := ' Score Group'; + for j := c2 to c3 do + begin + strvalue := format('%4d',[s5[j-1]]); + outline := outline + strvalue; + end; + outline := outline + ' Total'; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add('ITEM' ); + OutputFrm.RichEdit.Lines.Add(''); + for i := 1 to r do + begin + outline := format('%4d ',[i5[i-1]]); + for j := c2 to c3 do + begin + strvalue := format('%4d',[f[i-1,j-1]]); + outline := outline + strvalue; + end; + strvalue := format('%7d',[rowtot[i-1]]); + outline := outline + strvalue; + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := 'Total '; + for j := c2 to c3 do + begin + strvalue := format('%4d',[S[j-1]]); + outline := outline + strvalue; + end; + strvalue := format('%7d',[T]); + outline := outline + strvalue; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add( ''); + if (c3 = C1) then Done := true + else begin + c2 := c3 + 1; + c3 := c2 + 15; + if (c3 > C1) then c3 := C1; + end; + end; // end while not done +end; // end sub frequencies + +procedure TRaschFrm.GETLOGS(VAR L : DblDyneVec; + VAR L1 : DblDyneVec; + VAR L2 : DblDyneVec; + VAR g : DblDyneVec; + VAR g2 : DblDyneVec; + VAR f2 : DblDyneVec; + VAR rowtot : IntDyneVec; + k : integer; + VAR s5 : IntDyneVec; + VAR S : IntDyneVec; + T, r, C1 : integer; + VAR v1 : double; + VAR v2 : double); +var + tx, rowtx, rx, t2, t3, e : double; + i, j : integer; + outline : string; + +begin + t2 := 0.0; + tx := T; + rx := r; + for i := 0 to r-1 do + begin + rowtx := rowtot[i]; + L[i] := ln(rowtx / (tx - rowtx)); + t2 := t2 + L[i]; + end; + t2 := t2 / rx; + for i := 0 to r-1 do + begin + L1[i] := L[i] - t2; + L2[i] := L1[i] * L1[i]; + v1 := v1 + L2[i]; + end; + v1 := v1 / rx; + OutputFrm.RichEdit.Lines.Add( 'Item Log Odds Deviation Squared Deviation'); + for i := 0 to r-1 do + begin + outline := format('%3d %6.2f %6.2f %6.2f', + [i+1,L[i],L1[i],L2[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + t3 := 0.0; + v2 := 0.0; + for j := 0 to C1-1 do + begin + e := s5[j]; + g[j] := ln(e / (k - e)); + g2[j] := S[j] * g[j]; + t3 := t3 + g2[j]; + f2[j] := S[j] * (g[j] * g[j]); + v2 := v2 + f2[j]; + end; + t3 := t3 / tx; + v2 := v2 / (tx - (t3 * t3)); + OutputFrm.RichEdit.Lines.Add('Score Frequency Log Odds Freq.x Log Freq.x Log Odds Squared'); + for j := 0 to C1-1 do + begin + outline := format('%3d %3d %6.2f %6.2f %6.2f', + [s5[j],S[j],g[j],g2[j],f2[j]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; +end; //end of getlogs + +procedure TRaschFrm.GETSCORES(VAR noselected : integer; + VAR selected : IntDyneVec; + NoCases : integer; + f : IntDyneMat; + VAR mean : DblDyneVec; + VAR xsqr : DblDyneVec; + VAR sumxy : DblDyneVec; + VAR S : IntDyneVec; + VAR X : IntDyneVec; + VAR sumx : double; + VAR sumx2 : double; + VAR N : integer); +var + i, j, k1, T, item : integer; + outline, strvalue : string; +begin + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Rasch One-Parameter Logistic Test Scaling (Item Response Theory)'); + OutputFrm.RichEdit.Lines.Add('Written by William G. Miller'); + OutputFrm.RichEdit.Lines.Add(''); + k1 := noselected; + for i := 1 to k1 do + begin + for j := 1 to k1 + 2 do + begin + f[i-1,j-1] := 0; + end; + mean[i-1] := 0.0; + xsqr[i-1] := 0.0; + sumxy[i-1] := 0.0; + end; + for j := 1 to k1 + 2 do S[j-1] := 0; + N := 0; + sumx := 0.0; + sumx2 := 0.0; + + //Read each case and scores for each item. Eliminate rows (subjects) + //that have a total score of zero or all items correct + for i := 1 to NoCases do + begin + if (not GoodRecord(i,noselected,selected)) then continue; + T := 0; + for j := 1 to k1 do + begin + item := selected[j-1]; + X[j-1] := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[item,i]))); + T := T + X[j-1]; + end; + if ((T < k1) and (T > 0)) then + begin + outline := format('Case %3d Total Score := %3d Item scores',[i,T]); + sumx := sumx + T; + sumx2 := sumx2 + (T * T); + for j := 0 to k1-1 do + begin + mean[j] := mean[j] + X[j]; + xsqr[j] := xsqr[j] + (X[j] * X[j]); + sumxy[j] := sumxy[j] + (X[j] * T); + strvalue := format('%2d',[X[j]]); + outline := outline + strvalue; + if (X[j] = 0) then f[j,T-1] := f[j,T-1] + 1; + end; + OutputFrm.RichEdit.Lines.Add(outline); + S[T-1] := S[T-1] + 1; + N := N + 1; + end + else begin + outline := format('case %3d eliminated. Total score was %3d', + [i, T]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + OutputFrm.RichEdit.Lines.Add(''); +end; //end sub getscores + +procedure TRaschFrm.MAXABILITY(VAR expdcnt : DblDyneVec; + VAR d2 : DblDyneVec; + VAR e2 : DblDyneVec; + VAR p1 : DblDyneMat; + VAR p2 : DblDyneVec; + VAR P : DblDyneVec; + C1, r : integer; + D : DblDyneMat; + VAR s5 : IntDyneVec; + noloops : integer); +var + i, j : integer; + d9 : double; + outline : string; + +begin + d9 := 0.0; + outline := format('Maximum Likelihood Iteration Number %2d',[noloops]); + OutputFrm.RichEdit.Lines.Add(outline); + for j := 0 to C1-1 do + begin + expdcnt[j] := 0.0; + d2[j] := 0.0; + end; + for i := 0 to r-1 do + begin + for j := 0 to C1-1 do + p1[i,j] := exp(p2[j] - P[i]) / (1.0 + exp(p2[j] - P[i])); + end; + for j := 0 to C1-1 do + begin + for i := 0 to r-1 do + begin + expdcnt[j] := expdcnt[j] + p1[i,j]; + // expected number in score group + D[i,j] := exp(p2[j] - P[i]) / (sqrt(1.0 + exp(p2[j] - P[i]))); + d2[j] := d2[j] + D[i,j]; // rate of change value + end; + end; + for j := 0 to C1-1 do + begin + e2[j] := expdcnt[j] - s5[j]; // discrepency + e2[j] := e2[j] / d2[j]; + if (abs(e2[j]) > d9) then d9 := abs(e2[j]); + p2[j] := p2[j] - e2[j]; + end; +{ Debug check in old sample program + ' writeln + ' writeln('Actual and Estimated Scores') + ' writeln + ' writeln('Score Estimated Adjustment') + ' for j := 1 to c1 do + ' writeln(s5(j):3,' ',expdcnt(j):6:2,' ',e2(j):6:2) + ' writeln +} +end; // end of maxability + +function TRaschFrm.MAXITEM(VAR R1 : DblDyneVec; + VAR d1 : DblDyneVec; + VAR p1 : DblDyneMat; + VAR D : DblDyneMat; + VAR e1 : DblDyneVec; + VAR p2 : DblDyneVec; + VAR P : DblDyneVec; + VAR S : IntDyneVec; + VAR rowtot : IntDyneVec; + T, r, C1 : integer) : double; +var + i, j : integer; + d9 : double; + +begin + d9 := 0.0; + for i := 0 to r-1 do + begin + R1[i] := 0.0; + d1[i] := 0.0; + end; + for i := 0 to r-1 do + for j := 0 to C1-1 do + p1[i,j] := exp(p2[j] - P[i]) / (1.0 + exp(p2[j] - P[i])); + for i := 0 to r-1 do + begin + for j := 0 to C1-1 do R1[i] := R1[i] + S[j] * p1[i,j]; + e1[i] := R1[i] - (T - rowtot[i]); + end; + // e1(i) contains the difference between actual and expected passes + // now calculate derivatives and adjustments + for i := 0 to r-1 do + begin + for j := 0 to C1-1 do + begin + D[i,j] := exp(p2[j] - P[i]) / (sqrt(1.0 + exp(p2[j] - P[i]))); + d1[i] := d1[i] + (S[j] * D[i,j]); + end; + e1[i] := e1[i] / d1[i]; + // adjustment for item difficulty estimates + if (abs(e1[i]) > d9) then d9 := abs(e1[i]); + P[i] := P[i] + e1[i]; + end; +{ debug check from old sample program + ' writeln + ' writeln('actual and estimated items right') + ' writeln + ' writeln('item actual estimated adjustment') + ' for i := 1 to r do + ' begin + ' writeln(i:3,' ',(t-rowtot(i)):3,' ',e1(i):6:2) + ' end + ' writeln +} + Result := d9; +end; // end of maxitem subroutine + +procedure TRaschFrm.MAXOUT(r, C1 : integer; + VAR i5 : IntDyneVec; + VAR s5 : IntDyneVec; + VAR P : DblDyneVec; + VAR p2 : DblDyneVec); +var + i, j : integer; + outline : string; + +begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Maximum Likelihood Estimates'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Item Log Difficulty'); + for i := 0 to r-1 do + begin + outline := format('%3d %6.2f',[i5[i],P[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Score Log Ability'); + for j := 0 to C1-1 do + begin + outline := format('%3d %6.2f',[s5[j],p2[j]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; +end; // end of maxout + +procedure TRaschFrm.PROX(VAR P : DblDyneVec; + VAR p2 : DblDyneVec; + k, r, C1 : integer; + VAR L1 : DblDyneVec; + yexpand, xexpand : double; + VAR g : DblDyneVec; + T : integer; + VAR rowtot : IntDyneVec; + VAR i5 : IntDyneVec; + VAR s5 : IntDyneVec); +var + tx, rowtx, errorterm, stderror : double; + i, j : integer; + outline : string; +begin + if ProxChk.Checked then OutputFrm.RichEdit.Lines.Add(''); + for i := 0 to r-1 do P[i] := L1[i] * yexpand; + for j := 0 to C1-1 do p2[j] := g[j] * xexpand; + if ProxChk.Checked then + begin + OutputFrm.RichEdit.Lines.Add( 'Prox values and Standard Errors' ); + OutputFrm.RichEdit.Lines.Add(' '); + OutputFrm.RichEdit.Lines.Add('Item Scale Value Standard Error'); + end; + tx := T; + for i := 0 to r-1 do + begin + rowtx := rowtot[i]; + errorterm := tx / ((tx - rowtx) * rowtx); + //writeln(lst,'row := ',i:2,' yexpand := ',yexpand:8:2, + // total := ',t:8,' row total := ',rowtot(i):8, + // error term := ',errorterm:8:2) end; + stderror := yexpand * sqrt(errorterm); + if ProxChk.Checked then + begin + outline := format('%3d %7.3f %7.3f',[i5[i],P[i],stderror]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + if ProxChk.Checked then + begin + outline := format('Y expansion factor := %8.4f',[yexpand]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Score Scale Value Standard Error'); + end; + for j := 0 to C1-1 do + begin + stderror := xexpand * sqrt(k / (s5[j] * (k - s5[j]))); + if ProxChk.Checked then + begin + outline := format('%3d %7.3f %7.3f',[s5[j],p2[j],stderror]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + if ProxChk.Checked then + begin + outline := format('X expansion factor = %8.4f',[xexpand]); + OutputFrm.RichEdit.Lines.Add(outline); + end; +end; //end of prox + +Function TRaschFrm.REDUCE(k : integer; + VAR r : integer; + VAR T : integer; + VAR C1 : integer; + VAR i5 : IntDyneVec; + VAR rowtot : IntDyneVec; + VAR s5 : IntDyneVec; + VAR f : IntDyneMat; + VAR S : IntDyneVec) : integer; +var + Done : boolean; + check, i, j, column, row : integer; + outline : string; +begin // NOW REDUCE THE MATRIX BY ELIMINATING 0 OR 1 ROWS AND COLUMNS + OutputFrm.RichEdit.Lines.Add(''); + //Store item numbers in i5 array and initialize row totals + for i := 0 to k-1 do + begin + i5[i] := i+1; + rowtot[i] := 0; + end; + //Store group numbers in s5 array + r := k; + T := 0; + C1 := k - 1; // No. of score groups (all correct group eliminated) + for j := 0 to C1-1 do + begin + s5[j] := j+1; + T := T + S[j]; + end; + //Get row totals of the failures matrix (item totals) + for i := 0 to r-1 do + for j := 0 to C1-1 do rowtot[i] := rowtot[i] + f[i,j]; + // now check for item elimination + Done := false; + while (not Done) do + begin + for i := 1 to r do + begin + if ((rowtot[i-1] = 0) or (rowtot[i-1] = T)) then + begin + outline := format('Row %3d for item %3d eliminated.',[i,i5[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + if (i < r) then + begin + for j := i to r-1 do //move rows up to replace row i + begin + for column := 1 to C1 do + f[j-1,column-1] := f[j,column-1]; + rowtot[j-1] := rowtot[j]; + i5[j-1] := i5[j]; + end; + end; + r := r - 1; + end; // end if + end; // end for i + check := 1; + for i := 0 to r-1 do + if ((rowtot[i] = 0) or (rowtot[i] = T)) then check := 0; + if (check = 1) then Done := true; + end; + // check for group elimination + Done := false; + j := 1; + while (not Done) do + begin + if (S[j-1] = 0) then + begin + outline := format('Column %3d score group %3d eliminated - total group count = %3d', + [j, s5[j-1], S[j-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + if (j < C1) then + begin + for i := j to C1 - 1 do + begin + for row := 1 to r do + f[row-1,i-1] := f[row-1,i]; + S[i-1] := S[i]; + s5[i-1] := s5[i]; + end; + C1 := C1 - 1; + end + else C1 := C1 - 1; + end; + if C1 = 0 then + begin + ShowMessage('Too many cases or variables eliminated'); + OutputFrm.ShowModal; + Result := 1; + exit; + end; + if (S[j-1] > 0) then j := j + 1; + if (j >= C1) then + begin + while (S[C1-1] <= 0) do + begin + C1 := C1 - 1; + if C1 = 0 then + begin + ShowMessage('Too many cases or variables eliminated'); + OutputFrm.ShowModal; + Result := 1; + exit; + end; + end; + Done := true; + end; + end; + outline := format('Total number of score groups := %4d',[C1]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + Result := 0; +end; // end of reduce + +procedure TRaschFrm.SLOPES(VAR rptbis : DblDyneVec; + VAR rbis : DblDyneVec; + VAR slope : DblDyneVec; + N : integer; + sumx, sumx2 : double; + VAR sumxy : DblDyneVec; + r : integer; + VAR xsqr : DblDyneVec; + VAR mean : DblDyneVec); +var + propi, term1, term2, z, Y : double; + j : integer; +begin + z := 0.0; + term1 := N * sumx2 - sumx * sumx; + for j := 0 to r-1 do + begin + rptbis[j] := N * sumxy[j] - mean[j] * sumx; + term2 := N * xsqr[j] - (mean[j] * mean[j]); + if ((term1 > 0) and (term2 > 0)) then + rptbis[j] := rptbis[j] / sqrt(term1 * term2) + else rptbis[j] := 1.0; + propi := mean[j] / N; + if ((propi > 0.0) and (propi < 1.0)) then z := inversez(propi); + if (propi <= 0.0) then z := -3.0; + if (propi >= 1.0) then z := 3.0; + Y := ordinate(z); + if (Y > 0) then rbis[j] := rptbis[j] * (sqrt(propi * (1.0 - propi)) / Y) + else rbis[j] := 1.0; + if (rbis[j] <= -1.0) then rbis[j] := -0.99999; + if (rbis[j] >= 1.0) then rbis[j] := 0.99999; + slope[j] := rbis[j] / sqrt(1.0 - (rbis[j] * rbis[j])); + end; +end; // end of slopes procedure + +procedure TRaschFrm.TESTFIT(r, C1 : integer; + VAR f : IntDyneMat; + VAR S : IntDyneVec; + VAR P : DblDyneVec; + VAR p2 : DblDyneVec; + T : integer); +var + ct, ch, prob : double; + i, j : integer; + outline : string; +begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add( 'Goodness of Fit Test for Each Item'); + OutputFrm.RichEdit.Lines.Add('Item Chi-Squared Degrees of Probability'); + OutputFrm.RichEdit.Lines.Add('No. Value Freedom of Larger Value'); + ct := 0.0; + for i := 0 to r-1 do + begin + ch := 0.0; + for j := 0 to C1-1 do + ch := ch + (exp(p2[j] - P[i]) * f[i,j]) + (exp(P[i] - + p2[j]) * (S[j] - f[i,j])); + prob := 1.0 - chisquaredprob(ch, T - C1); + outline := format('%3d %8.2f %3d %6.4f',[i+1,ch,(T-C1),prob]); + OutputFrm.RichEdit.Lines.Add(outline); + ct := ct + ch; + end; + OutputFrm.RichEdit.Lines.Add(''); +end; // end of testfit + +procedure TRaschFrm.PLOTINFO(k, r : integer; + VAR info : DblDyneMat; + VAR A : DblDyneMat; + VAR slope : DblDyneVec; + VAR P : DblDyneVec); +var + min, max, cg, hincrement, Ymax, elg, term1, term2, jx : double; + headstring, valstring : string; + i, j, jj, size : integer; + TestInfo : DblDyneMat; +begin + min := -3.5; + max := 3.5; + size := 0; + hincrement := (max - min) / 50; + SetLength(TestInfo,52,2); + cg := 0.2; + Ymax := 0; + for i := 1 to r do // item loop + begin + TestInfo[i-1,0] := 0.0; + TestInfo[i-1,1] := 0.0; + jj := 1; + jx := min; + while (jx <= (max + hincrement)) do + begin + if (slope[i-1] > 30) then slope[i-1] := 30; + elg := 1.7 * slope[i-1] * (P[i-1] - jx); + elg := exp(elg); + term1 := 2.89 * (slope[i-1]) * (1.0 - cg) * (slope[i-1]) * (1.0 - cg); + term2 := (cg + elg) * (1.0 + 1.0 / elg) * (1.0 + 1.0 / elg); + info[i-1,jj-1] := term1 / term2; + if (info[i-1,jj-1] > Ymax) then Ymax := info[i-1,jj-1]; + jj := jj + 1; + jx := jx + hincrement; + end; + size := jj-1; + end; + for i := 1 to r do //item loop + begin + headstring := 'Item Information Function for Item '; + valstring := format('%3d',[i]); + headstring := headstring + valstring; + for j := 1 to size do + begin + A[j-1,0] := min + (hincrement * j ); + A[j-1,1] := info[i-1,j-1]; + TestInfo[j-1,1] := TestInfo[j-1,1] + info[i-1,j-1]; + end; + if ItemInfoChk.Checked then plot(A, size, headstring, 50, 50); + end; + for j := 1 to size do TestInfo[j-1,0] := min + (hincrement * j ); + headstring := 'Item Information Function for Test'; + if TestInfoChk.Checked then PlotTest(TestInfo,size,headstring,50,50); + TestInfo := nil; +end; //end of PlotInfo + +procedure TRaschFrm.plot(VAR xyarray : DblDyneMat; + arraysize : integer; + Title : string; + Vdivisions, Hdivisions : integer); +var + i : integer; + xvalue, yvalue : DblDyneVec; +begin + // Allocate space for point sets of means + SetLength(xvalue,arraysize); + SetLength(yvalue,arraysize); + SetLength(GraphFrm.Ypoints,1,arraysize); + SetLength(GraphFrm.Xpoints,1,arraysize); + // store points for means + for i := 0 to arraysize-1 do + begin + yvalue[i] := xyarray[i,1]; + xvalue[i] := xyarray[i,0]; + GraphFrm.Ypoints[0,i] := yvalue[i]; + GraphFrm.Xpoints[0,i] := xvalue[i]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := arraysize; + GraphFrm.Heading := Title; + GraphFrm.XTitle := 'log ability'; + GraphFrm.YTitle := 'Info'; +// GraphFrm.Ypoints[1] := yvalue; +// GraphFrm.Xpoints[1] := xvalue; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := true; + GraphFrm.GraphType := 5; // 2d line chart + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + + xvalue := nil; + yvalue := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; //end plot subroutine + +procedure TRaschFrm.PlotItems(r : integer; i5 : IntDyneVec; P : DblDyneVec); +var + i : integer; + xvalues : DblDyneVec; +begin + SetLength(xvalues,r); + SetLength(GraphFrm.Ypoints,1,r); + SetLength(GraphFrm.Xpoints,1,r); + for i := 1 to r do + begin + xvalues[i-1] := i5[i-1]; + GraphFrm.Xpoints[0,i-1] := xvalues[i-1]; + GraphFrm.Ypoints[0,i-1] := P[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := r; + GraphFrm.Heading := 'LOG DIFFICULTIES FOR ITEMS'; + GraphFrm.XTitle := 'ITEM'; + GraphFrm.YTitle := 'LOG DIFFICULTY'; +// GraphFrm.Ypoints[1] := P; +// GraphFrm.Xpoints[1] := xvalues; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := true; + GraphFrm.GraphType := 2; // bar chart + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + xvalues := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +procedure TRaschFrm.PlotScrs(C1 : integer; s5 : IntDyneVec; p2 : DblDyneVec); +var + i : integer; + xvalues : DblDyneVec; +begin + SetLength(xvalues,C1); + SetLength(GraphFrm.Ypoints,1,C1); + SetLength(GraphFrm.Xpoints,1,C1); + for i := 1 to C1 do + begin + xvalues[i-1] := s5[i-1]; + GraphFrm.Xpoints[0,i-1] := xvalues[i-1]; + GraphFrm.Ypoints[0,i-1] := p2[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := C1; + GraphFrm.Heading := 'LOG ABILITIES FOR SCORE GROUPS'; + GraphFrm.XTitle := 'SCORE'; + GraphFrm.YTitle := 'LOG ABILITY'; +// GraphFrm.Ypoints[1] := p2; +// GraphFrm.Xpoints[1] := xvalues; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := true; + GraphFrm.GraphType := 2; // bar chart + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + xvalues := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +procedure TRaschFrm.PlotTest(VAR TestInfo : DblDyneMat; + arraysize : integer; + Title : string; + Vdivisions, Hdivisions : integer); +var + i : integer; + xvalue, yvalue : DblDyneVec; +begin + // Allocate space for point sets of means + SetLength(xvalue,arraysize); + SetLength(yvalue,arraysize); + SetLength(GraphFrm.Ypoints,1,arraysize); + SetLength(GraphFrm.Xpoints,1,arraysize); + // store points for means + for i := 1 to arraysize do + begin + yvalue[i-1] := TestInfo[i-1,1]; + xvalue[i-1] := TestInfo[i-1,0]; + GraphFrm.Ypoints[0,i-1] := yvalue[i-1]; + GraphFrm.Xpoints[0,i-1] := xvalue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := arraysize; + GraphFrm.Heading := Title; + GraphFrm.XTitle := 'log ability'; + GraphFrm.YTitle := 'Info'; +// GraphFrm.Ypoints[1] := yvalue; +// GraphFrm.Xpoints[1] := xvalue; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := true; + GraphFrm.GraphType := 5; // 2d line chart + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + + xvalue := nil; + yvalue := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; //end plot subroutine + + +initialization + {$I raschunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/relchangeunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/relchangeunit.lfm new file mode 100644 index 000000000..6480b03d9 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/relchangeunit.lfm @@ -0,0 +1,253 @@ +object RelChangeFrm: TRelChangeFrm + Left = 855 + Height = 163 + Top = 410 + Width = 400 + AutoSize = True + BorderStyle = bsSingle + Caption = 'Variance Change Affect on Reliability' + ClientHeight = 163 + ClientWidth = 400 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CancelBtn + Left = 103 + Height = 25 + Top = 128 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 2 + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + Left = 169 + Height = 25 + Top = 128 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 243 + Height = 25 + Top = 128 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 331 + Height = 25 + Top = 128 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 5 + end + object HelpBtn: TButton + Tag = 142 + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ResetBtn + Left = 40 + Height = 25 + Top = 128 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 1 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 51 + Height = 104 + Top = 8 + Width = 299 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 104 + ClientWidth = 299 + TabOrder = 0 + object Label1: TLabel + AnchorSideTop.Control = OldRelEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = OldVarEdit + Left = 28 + Height = 15 + Top = 4 + Width = 190 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Reliability (r) of the reference group:' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = OldVarEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = OldRelEdit + Left = 28 + Height = 15 + Top = 31 + Width = 190 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Variance (s2) of the reference group:' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = NewVarEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NewVarEdit + Left = 54 + Height = 15 + Top = 58 + Width = 164 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Variance (S2) of the new group:' + ParentColor = False + end + object Label4: TLabel + AnchorSideTop.Control = NewRelEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NewRelEdit + Left = 0 + Height = 15 + Top = 85 + Width = 218 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Estimated reliability (R) of the new group:' + ParentColor = False + end + object OldRelEdit: TEdit + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 226 + Height = 23 + Top = 0 + Width = 73 + Alignment = taRightJustify + Anchors = [akTop, akRight] + TabOrder = 0 + Text = 'OldRelEdit' + end + object OldVarEdit: TEdit + AnchorSideLeft.Control = OldRelEdit + AnchorSideTop.Control = OldRelEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 226 + Height = 23 + Top = 27 + Width = 73 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 1 + Text = 'Edit1' + end + object NewVarEdit: TEdit + AnchorSideLeft.Control = OldRelEdit + AnchorSideTop.Control = OldVarEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 226 + Height = 23 + Top = 54 + Width = 73 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 2 + Text = 'Edit1' + end + object NewRelEdit: TEdit + AnchorSideLeft.Control = OldRelEdit + AnchorSideTop.Control = NewVarEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 226 + Height = 23 + Top = 81 + Width = 73 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 3 + Text = 'Edit1' + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 112 + Width = 400 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/relchangeunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/relchangeunit.pas new file mode 100644 index 000000000..64ef27ec6 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/relchangeunit.pas @@ -0,0 +1,110 @@ +unit RelChangeUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + ContextHelpUnit; + +type + + { TRelChangeFrm } + + TRelChangeFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + OldRelEdit: TEdit; + OldVarEdit: TEdit; + NewVarEdit: TEdit; + NewRelEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + RelChangeFrm: TRelChangeFrm; + +implementation + +uses + Math; + +{ TRelChangeFrm } + +procedure TRelChangeFrm.ResetBtnClick(Sender: TObject); +begin + OldRelEdit.Text := ''; + NewRelEdit.Text := ''; + OldVarEdit.Text := ''; + NewVarEdit.Text := ''; +end; + +procedure TRelChangeFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinHeight := Height; + Constraints.MaxHeight := Height; + + FAutoSized := true; +end; + +procedure TRelChangeFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TRelChangeFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TRelChangeFrm.ComputeBtnClick(Sender: TObject); +var + OldRel, NewRel, OldVar, NewVar : double; +begin + OldRel := StrToFloat(OldRelEdit.Text); + OldVar := StrToFloat(OldVarEdit.Text); + NewVar := StrToFloat(NewVarEdit.Text); + NewRel := 1.0 - ((OldVar / NewVar) * (1.0 - OldRel)); + NewRelEdit.Text := FormatFloat('0.00000', NewRel); //FloatToStr(NewRel); +end; + + +initialization + {$I relchangeunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/spbrunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/spbrunit.lfm new file mode 100644 index 000000000..3104c2c61 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/spbrunit.lfm @@ -0,0 +1,224 @@ +object SpBrFrm: TSpBrFrm + Left = 770 + Height = 149 + Top = 373 + Width = 473 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Spearman-Brown Prophecy Formula' + ClientHeight = 149 + ClientWidth = 473 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CancelBtn + Left = 172 + Height = 25 + Top = 101 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 2 + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + Left = 238 + Height = 25 + Top = 101 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 312 + Height = 25 + Top = 101 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 400 + Height = 25 + Top = 101 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 5 + end + object HelpBtn: TButton + Tag = 147 + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ResetBtn + Left = 109 + Height = 25 + Top = 101 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 1 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 120 + Height = 77 + Top = 8 + Width = 233 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BevelOuter = bvNone + ClientHeight = 77 + ClientWidth = 233 + TabOrder = 0 + object Label1: TLabel + AnchorSideTop.Control = OldRelEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = OldRelEdit + Left = 28 + Height = 15 + Top = 4 + Width = 122 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Original Test Reliability:' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = MultKEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = MultKEdit + Left = 0 + Height = 15 + Top = 31 + Width = 150 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Multiplier K for the new Test:' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = NewRelEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NewRelEdit + Left = 21 + Height = 15 + Top = 58 + Width = 129 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'New Reliability Estimate:' + ParentColor = False + end + object OldRelEdit: TEdit + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 158 + Height = 23 + Top = 0 + Width = 75 + Alignment = taRightJustify + Anchors = [akTop, akRight] + TabOrder = 0 + Text = 'OldRelEdit' + end + object MultKEdit: TEdit + AnchorSideLeft.Control = OldRelEdit + AnchorSideTop.Control = OldRelEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 158 + Height = 23 + Top = 27 + Width = 75 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 1 + Text = 'Edit1' + end + object NewRelEdit: TEdit + AnchorSideLeft.Control = OldRelEdit + AnchorSideTop.Control = MultKEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 158 + Height = 23 + Top = 54 + Width = 75 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 2 + Text = 'Edit1' + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 85 + Width = 473 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/spbrunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/spbrunit.pas new file mode 100644 index 000000000..d9b45ba7b --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/spbrunit.pas @@ -0,0 +1,99 @@ +unit SpBrUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + ContextHelpUnit; + +type + + { TSpBrFrm } + + TSpBrFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + OldRelEdit: TEdit; + MultKEdit: TEdit; + NewRelEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + SpBrFrm: TSpBrFrm; + +implementation + +uses + Math; + +{ TSpBrFrm } + +procedure TSpBrFrm.ResetBtnClick(Sender: TObject); +begin + OldRelEdit.Text := ''; + NewRelEdit.Text := ''; + MultKEdit.Text := ''; +end; + +procedure TSpBrFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MaxHeight := Height; + Constraints.MinHeight := Height; +end; + +procedure TSpBrFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TSpBrFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TSpBrFrm.ComputeBtnClick(Sender: TObject); +var + oldrel, newrel, Factor : double; +begin + oldrel := StrToFloat(OldRelEdit.Text); + Factor := StrToFloat(MultKEdit.Text); + newrel := (Factor * oldrel) / (1.0 + (Factor - 1.0) * oldrel); + NewRelEdit.Text := FormatFloat('0.00000', NewRel); //FloatToStr(newrel); +end; + + +initialization + {$I spbrunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/succintunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/succintunit.lfm new file mode 100644 index 000000000..7aa5fc465 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/succintunit.lfm @@ -0,0 +1,190 @@ +object SuccIntFrm: TSuccIntFrm + Left = 864 + Height = 326 + Top = 391 + Width = 335 + AutoSize = True + Caption = 'Successive Interval Scaling' + ClientHeight = 326 + ClientWidth = 335 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = VarList + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ItemList + AnchorSideTop.Control = Owner + Left = 198 + Height = 15 + Top = 8 + Width = 93 + BorderSpacing.Top = 8 + Caption = 'Selected Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 252 + Top = 25 + Width = 128 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 153 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 153 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrCenter + Left = 144 + Height = 25 + Top = 139 + Width = 46 + AutoSize = True + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 3 + end + object ItemList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 198 + Height = 252 + Top = 25 + Width = 129 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 4 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 126 + Height = 25 + Top = 293 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 188 + Height = 25 + Top = 293 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 272 + Height = 25 + Top = 293 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 7 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 277 + Width = 335 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/succintunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/succintunit.pas new file mode 100644 index 000000000..d349d6e7d --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/succintunit.pas @@ -0,0 +1,632 @@ +// Test file: sucsintv.laz, use all variables. + +unit SuccIntUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, Globals, DataProcs; + +type + + { TSuccIntFrm } + + TSuccIntFrm = class(TForm) + Bevel1: TBevel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + InBtn: TBitBtn; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + Label1: TLabel; + Label2: TLabel; + ItemList: TListBox; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + SuccIntFrm: TSuccIntFrm; + +implementation + +uses + Math; + +{ TSuccIntFrm } + +procedure TSuccIntFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + ItemList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TSuccIntFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Max( + 2*MaxValue([Label1.Width, Label2.Width]) + 2*AllBtn.Width + 4*VarList.BorderSpacing.Left, // 2 * AllBtn.Width to avoid window to get too narrow + 3*w + 4*CloseBtn.BorderSpacing.Right + ); + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TSuccIntFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TSuccIntFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TSuccIntFrm.AllBtnClick(Sender: TObject); +var + i: integer; +begin + for i := 0 to VarList.Items.Count - 1do + ItemList.Items.Add(VarList.Items[i]); + UpdateBtnStates; +end; + +procedure TSuccIntFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, col, X, NoSelected, MaxCat, count, subscript : integer; + discrow : integer; + CatCount : IntDyneVec; + ColNoSelected : IntDyneVec; + FreqMat : IntDyneMat; + RowTots : IntDyneVec; + PropMat, Zmatrix, WidthMat, TheorZMat, ThCumPMat, CumMat : DblDyneMat; + DiscDisp, Mean, StdDev, CumWidth, ScaleValue : DblDyneVec; + d1, d2, C1, L1, L2, t3, sum, discrep, z, prop, maxdiscrep : double; + RowLabels, ColLabels : StrDyneVec; + outline: string; + Save_Cursor : TCursor; + found : boolean; + lReport: TStrings; +begin + if ItemList.Items.Count = 0 then + begin + MessageDlg('No variables selected.', mtError, [mbOK], 0); + exit; + end; + + MaxCat := 0; + L1 := 0.01; + L2 := 0.99; + maxdiscrep := 0.0; + + // Allocate space + SetLength(DiscDisp,NoVariables); + SetLength(ScaleValue,NoVariables); + SetLength(RowLabels,NoVariables); + SetLength(ColNoSelected,NoVariables); + + // Get items selected + NoSelected := ItemList.Items.Count; + for i := 1 to NoSelected do + begin + for j := 1 to NoVariables do + begin + outline := ItemList.Items.Strings[i-1]; + if outline = OS3MainFrm.DataGrid.Cells[j,0] then ColNoSelected[i-1] := j; + end; + end; +(* + OutputFrm.RichEdit.Lines.Add('check of parameters'); + outline := format('No Selected = %3d',[NoSelected]); + OutputFrm.RichEdit.Lines.Add(outline); + for i := 1 to NoSelected do + begin + outline := format('ItemList %d = %s',[i-1,ItemList.Items.Strings[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Col. No. Selected %3d = %3d',[i-1,ColNoSelected[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; +*) + //Find largest category value in data + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + for j := 1 to NoSelected do + begin + col := ColNoSelected[j-1]; + X := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i]))); + if (X > MaxCat) then MaxCat := X; + end; + end; + + // Initialize arrays + SetLength(CatCount,MaxCat); + SetLength(FreqMat,NoVariables,MaxCat); + SetLength(RowTots,NoVariables); + SetLength(PropMat,NoVariables,MaxCat); + SetLength(Zmatrix,NoVariables,MaxCat); + SetLength(WidthMat,NoVariables,MaxCat); + SetLength(TheorZMat,NoVariables,MaxCat); + SetLength(ThCumPMat,NoVariables,MaxCat); + SetLength(CumMat,NoVariables,MaxCat); + SetLength(Mean,MaxCat); + SetLength(StdDev,MaxCat); + SetLength(CumWidth,MaxCat); + SetLength(ColLabels,MaxCat); + + for i := 0 to NoSelected-1 do + begin + RowTots[i] := 0; + DiscDisp[i] := 0.0; + ScaleValue[i] := 0.0; + for j := 0 to MaxCat-1 do + begin + FreqMat[i,j] := 0; + PropMat[i,j] := 0.0; + CumMat[i,j] := 0.0; + Zmatrix[i,j] := 0.0; + WidthMat[i,j] := 0.0; + TheorZMat[i,j] := 0.0; + ThCumPMat[i,j] := 0.0; + end; + end; + for j := 0 to MaxCat-1 do + begin + CumWidth[j] := 0.0; + StdDev[j] := 0.0; + Mean[j] := 0.0; + CatCount[j] := 0; + end; + + Save_Cursor := Screen.Cursor; // save current cursor + Screen.Cursor := crHourGlass; // Show hourglass cursor + + //Build frequency matrix + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + for j := 1 to NoSelected do + begin + col := ColNoSelected[j-1]; + X := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i]))); + if ((X > 0) and (X <= MaxCat)) then + FreqMat[j-1,X-1] := FreqMat[j-1,X-1] + 1; + end; + end; + + // Get row totals of the frequency matrix + for i := 0 to NoSelected-1 do + begin + RowTots[i] := 0; + for j := 0 to MaxCat-1 do + begin + RowTots[i] := RowTots[i] + FreqMat[i,j]; + end; + end; + + // Convert frequencies to proportions of the row totals + for i := 0 to NoSelected-1 do + for j := 0 to MaxCat-1 do + PropMat[i,j] := FreqMat[i,j] / RowTots[i]; + + // Accumulate the proportions accross the categories + for i := 1 to NoSelected do + begin + CumMat[i-1,0] := PropMat[i-1,0]; + for j := 2 to MaxCat do + begin + CumMat[i-1,j-1] := CumMat[i-1,j-2] + PropMat[i-1,j-1]; + if (j = MaxCat) then CumMat[i-1,j-1] := 1.0; + end; + end; + + // Convert cumulative proportions to z scores + for i := 0 to NoSelected-1 do + begin + for j := 0 to MaxCat-1 do + begin + if (CumMat[i,j] < L1) then Zmatrix[i,j] := 99.0; //flag -infinity + if (CumMat[i,j] > L2) then Zmatrix[i,j] := 99.0; //flag +infinity + if ((CumMat[i,j] >= L1) and (CumMat[i,j] <= L2)) then + Zmatrix[i,j] := inversez(CumMat[i,j]); + end; + end; + + // Obtain discriminal dispersions of the items + t3 := 0.0; + for i := 1 to NoSelected do + begin + d1 := 0.0; + d2 := 0.0; + C1 := 0.0; + for j := 1 to MaxCat - 1 do + begin + if (Zmatrix[i-1,j-1] <> 99.0) then + begin + d1 := d1 + Zmatrix[i-1,j-1]; + d2 := d2 + (Zmatrix[i-1,j-1] * Zmatrix[i-1,j-1]); + C1 := C1 + 1.0; + end; + end; + if (C1 > 1) then + begin + DiscDisp[i-1] := d2 - ((d1 * d1) / C1); + DiscDisp[i-1] := DiscDisp[i-1] / (C1-1.0); + DiscDisp[i-1] := sqrt(DiscDisp[i-1]); + end + else DiscDisp[i-1] := 99.0; + if ((DiscDisp[i-1] > 0) and (DiscDisp[i-1] <> 99.0))then t3 := t3 + (1.0 / DiscDisp[i-1]); + end; + + //Constant t3 =No. items / recipricols of std.dev.s of item z scores + t3 := NoSelected / t3; + for i := 0 to NoSelected-1 do + begin + if ((DiscDisp[i] > 0.0) and (t3 > 0)) then + DiscDisp[i] := (1.0 / DiscDisp[i]) * t3 + else + DiscDisp[i] := 99.0; + end; + + // Now, calculate interval widths + for j := 2 to MaxCat - 1 do + begin + for i := 1 to NoSelected do + begin + if ((Zmatrix[i-1,j-1] <> 99.0) and (Zmatrix[i-1,j-2] <> 99.0)) then + WidthMat[i-1,j-2] := Zmatrix[i-1,j-1] - Zmatrix[i-1,j-2] + else + WidthMat[i-1,j-2] := 99.0; + end; + end; + + //Calculate Means and Standard Deviations of category Widths + for j := 1 to MaxCat-2 do + begin + for i := 1 to NoSelected do + begin + if (WidthMat[i-1,j-1] <> 99.0) then + begin + CatCount[j-1] := CatCount[j-1] + 1; + Mean[j-1] := Mean[j-1] + WidthMat[i-1,j-1]; + StdDev[j-1] := StdDev[j-1] + (WidthMat[i-1,j-1] * WidthMat[i-1,j-1]); + end; + end; + if (CatCount[j-1] > 1) then + begin + Mean[j-1] := Mean[j-1] / CatCount[j-1]; + StdDev[j-1] := (StdDev[j-1] / CatCount[j-1]) - (Mean[j-1] * Mean[j-1]); + StdDev[j-1] := StdDev[j-1] * (CatCount[j-1] / (CatCount[j-1] - 1)); + end; + end; + + // Calculate cumulative widths + CumWidth[0] := Mean[0]; + for j := 2 to MaxCat - 1 do + CumWidth[j-1] := CumWidth[j-2] + Mean[j-1]; + + // Calculate scale item scale values + for i := 1 to NoSelected do + begin + found := false; + count := 1; + while (not found) do + begin + if (CumMat[i-1,count-1] >= 0.5) then + begin + found := true; + subscript := count; + end; + if (count = (MaxCat)) then + begin + found := true; + subscript := count; + end; + count := count + 1; + end; + + if ((subscript > 2) and (subscript < MaxCat)) then + begin + ScaleValue[i-1] := Mean[subscript-2] * ((0.5 - CumMat[i-1,subscript-2]) / PropMat[i-1,subscript-1]); + if (subscript > 1) then + ScaleValue[i-1] := ScaleValue[i-1] + CumWidth[subscript-3]; + end + else + begin //extreme value - get average of z scores in first cat. and / 2 + sum := 0.0; + for k := 1 to NoSelected do sum := sum + Zmatrix[i-1,0]; + sum := sum / abs(NoSelected * 2); + ScaleValue[i-1] := sum * ((0.5 - (CumMat[i-1,0] / 2.0)) / (CumMat[i-1,0] / 2.0)); + end; + + end; + + //Calculate Theoretical z scores from the scale values + discrep := 0.0; + count := 0; + for i := 1 to NoSelected do + begin + z := -ScaleValue[i-1]; + TheorZMat[i-1,0] := z; + prop := probz(z); + ThCumPMat[i-1,0] := prop; + for j := 2 to MaxCat - 1 do + begin + z := CumWidth[j-2] - ScaleValue[i-1]; + if (z < -3) then z := -3.0; + if (z > 3) then z := 3.0; + prop := probz(z); + TheorZMat[i-1,j-1] := z; + ThCumPMat[i-1,j-1] := prop; + discrep := discrep + abs(CumMat[i-1,j-1] - prop); + if abs(CumMat[i-1,j-1] - prop) > maxdiscrep then + begin + maxdiscrep := abs(CumMat[i-1,j-1] - prop); + discrow := i; + end; + count := count + 1; + end; + ThCumPMat[i-1,MaxCat-1] := 1.0; + end; + discrep := discrep / count; // average discrepency between theoretical and observed + + // Report results + lReport := TStringList.Create; + try + lReport.Add(' SUCCESSIVE INTERVAL SCALING RESULTS'); + lReport.Add(''); + for i := 1 to NoSelected do + RowLabels[i-1] := OS3MainFrm.DataGrid.Cells[ColNoSelected[i-1],0]; + for i := 1 to MaxCat do + ColLabels[i-1] := Format(' %2d-%2d ', [i-1, i]); + + outline := ' '; + for i := 1 to MaxCat do outline := outline + ColLabels[i-1]; + lReport.Add(outline); + + for i := 1 to NoSelected do + begin + lReport.Add('%10s', [RowLabels[i-1]]); + + outline := 'Frequency '; + for j := 1 to MaxCat do + outline := outline + Format('%7d', [FreqMat[i-1,j-1]]); + lReport.Add(outline); + + outline := 'Proportion '; + for j := 1 to MaxCat do + outline := outline + Format('%7.3f', [PropMat[i-1,j-1]]); + lReport.Add(outline); + + outline := 'Cum. Prop. '; + for j := 1 to MaxCat do + outline := outline + Format('%7.3f', [CumMat[i-1,j-1]]); + lReport.Add(outline); + + outline := 'Normal z '; + for j := 1 to MaxCat do + begin + if (Zmatrix[i-1,j-1] <> 99.0) then + outline := outline + Format('%7.3f', [Zmatrix[i-1,j-1]]) + else + outline := outline + ' - '; + end; + lReport.Add(outline); + end; + + lReport.Add(''); + lReport.Add(' INTERVAL WIDTHS'); + outline := ' '; + for i := 1 to MaxCat - 2 do + outline := outline + Format(' %2d-%2d ', [i+1,i]); + lReport.Add(outline); + + outline := ''; + for i := 1 to NoSelected do + begin + outline := outline + Format('%10s', [RowLabels[i-1]]); + for j := 1 to MaxCat-2 do + begin + if (WidthMat[i-1,j-1] <> 99.0) then + outline := outline + Format('%7.3f', [WidthMat[i-1,j-1]]) + else + outline := outline + ' - '; + end; + lReport.Add(outline); + outline := ''; + end; + lReport.Add(''); + + outline := 'Mean Width'; + for i := 1 to MaxCat - 2 do + outline := outline + Format('%7.2f', [Mean[i-1]]); + lReport.Add(outline); + + outline := 'No. Items '; + for i := 1 to MaxCat - 2 do + outline := outline + Format('%7d', [CatCount[i-1]]); + lReport.Add(outline); + + outline := 'Std. Dev.s'; + for i := 1 to MaxCat - 2 do + outline := outline + Format('%7.2f', [StdDev[i-1]]);; + lReport.Add(outline); + + outline := 'Cum. Means'; + for i := 1 to MaxCat - 2 do + outline := outline + Format('%7.2f', [CumWidth[i-1]]); + lReport.Add(outline); + lReport.Add(''); + + lReport.Add('ESTIMATES OF SCALE VALUES AND THEIR DISPERSIONS'); + lReport.Add('Item No. Ratings Scale Value Discriminal Dispersion'); + for i := 0 to NoSelected-1 do + lReport.Add('%10s %3d %6.3f %6.3f', [RowLabels[i], RowTots[i], ScaleValue[i], DiscDisp[i]]); + lReport.Add(''); + + lReport.Add('Z scores Estimated from Scale values'); + outline := ' '; + for i := 0 to MaxCat-1 do outline := outline + ColLabels[i]; + lReport.Add(outline); + for i := 1 to NoSelected do + begin + outline := Format('%10s', [RowLabels[i-1]]); + for j := 1 to MaxCat - 1 do + outline := outline + Format('%7.3f', [TheorZMat[i-1,j-1]]); + lReport.Add(outline); + end; + lReport.Add(''); + + lReport.Add('Cumulative Theoretical Proportions'); + outline := ' '; + for i := 1 to MaxCat do outline := outline + ColLabels[i-1]; + lReport.Add(outline); + for i := 1 to NoSelected do + begin + outline := Format('%10s', [RowLabels[i-1]]); + for j := 1 to MaxCat do + outline := outline + Format('%7.3f', [ThCumPMat[i-1,j-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + lReport.Add(''); + + outline := 'Average Discrepancy Between Theoretical and Observed Cumulative Proportions: '; + outline := outline + Format('%.3f', [discrep]); + lReport.Add(outline); + + lReport.Add('Maximum discrepancy %.3f found in item %s', [maxdiscrep, RowLabels[discrow-1]]); + + Screen.Cursor := Save_Cursor; + DisplayReport(lReport); + + finally + lReport.Free; + + ColLabels := nil; + RowLabels := nil; + ScaleValue := nil; + CumWidth := nil; + StdDev := nil; + Mean := nil; + DiscDisp := nil; + CumMat := nil; + ThCumPMat := nil; + TheorZMat := nil; + WidthMat := nil; + Zmatrix := nil; + PropMat := nil; + RowTots := nil; + FreqMat := nil; + CatCount := nil; + ColNoSelected := nil; + end; +end; + +procedure TSuccIntFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + ItemList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TSuccIntFrm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < ItemList.Items.Count do + begin + if ItemList.Selected[i] then + begin + VarList.Items.Add(ItemList.Items[i]); + ItemList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TSuccIntFrm.UpdateBtnStates; +var + lSelected: Boolean; + i: Integer; +begin + lSelected := false; + for i := 0 to VarList.Items.Count - 1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + InBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to ItemList.Items.Count -1 do + if ItemList.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; + + AllBtn.Enabled := VarList.Items.Count > 0; +end; + +procedure TSuccIntFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I succintunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/testgenunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/testgenunit.lfm new file mode 100644 index 000000000..b8f56d3c2 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/testgenunit.lfm @@ -0,0 +1,289 @@ +object TestGenFrm: TTestGenFrm + Left = 246 + Height = 279 + Top = 166 + Width = 336 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Test Data Generation' + ClientHeight = 279 + ClientWidth = 336 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Options: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + Left = 63 + Height = 70 + Top = 151 + Width = 210 + AutoFill = True + AutoSize = True + BorderSpacing.Top = 12 + Caption = 'Generate responses that are:' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 50 + ClientWidth = 206 + Items.Strings = ( + 'True / False (dichotomous 0 or 1)' + 'Contnuous' + ) + TabOrder = 1 + end + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CancelBtn + Left = 31 + Height = 25 + Top = 237 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 2 + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + Left = 97 + Height = 25 + Top = 237 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 171 + Height = 25 + Top = 237 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 259 + Height = 25 + Top = 237 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 5 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Options + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 221 + Width = 336 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 12 + Height = 139 + Top = 0 + Width = 312 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Right = 12 + BevelOuter = bvNone + ClientHeight = 139 + ClientWidth = 312 + TabOrder = 0 + object Label1: TLabel + AnchorSideTop.Control = NoItemsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NoItemsEdit + Left = 22 + Height = 15 + Top = 12 + Width = 206 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Number of item (Variables) to Generate' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = NoCasesEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NoCasesEdit + Left = 15 + Height = 15 + Top = 39 + Width = 213 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Number of Subjects (Cases) to Generate:' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = MeanEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = MeanEdit + Left = 30 + Height = 15 + Top = 66 + Width = 198 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'What is the desired Total Score Mean?' + ParentColor = False + end + object Label4: TLabel + AnchorSideTop.Control = SDEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = SDEdit + Left = 0 + Height = 15 + Top = 93 + Width = 228 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'What is the desired test standard deviation?' + ParentColor = False + end + object Label5: TLabel + AnchorSideTop.Control = RelEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = RelEdit + Left = 50 + Height = 15 + Top = 120 + Width = 178 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'What is the desired test reliability?' + ParentColor = False + end + object NoItemsEdit: TEdit + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 236 + Height = 23 + Top = 8 + Width = 76 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + OnKeyPress = NoItemsEditKeyPress + TabOrder = 0 + Text = 'NoItemsEdit' + end + object NoCasesEdit: TEdit + AnchorSideTop.Control = NoItemsEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 236 + Height = 23 + Top = 35 + Width = 76 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + OnKeyPress = NoCasesEditKeyPress + TabOrder = 1 + Text = 'Edit1' + end + object MeanEdit: TEdit + AnchorSideTop.Control = NoCasesEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 236 + Height = 23 + Top = 62 + Width = 76 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + OnKeyPress = MeanEditKeyPress + TabOrder = 2 + Text = 'Edit1' + end + object SDEdit: TEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = MeanEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 236 + Height = 23 + Top = 89 + Width = 76 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + OnKeyPress = SDEditKeyPress + TabOrder = 3 + Text = 'Edit1' + end + object RelEdit: TEdit + AnchorSideTop.Control = SDEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 236 + Height = 23 + Top = 116 + Width = 76 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + OnKeyPress = RelEditKeyPress + TabOrder = 4 + Text = 'Edit1' + end + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/testgenunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/testgenunit.pas new file mode 100644 index 000000000..0ca5256be --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/testgenunit.pas @@ -0,0 +1,211 @@ +unit TestGenUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Math, + MainUnit, Globals, DictionaryUnit; + +type + + { TTestGenFrm } + + TTestGenFrm = class(TForm) + Bevel1: TBevel; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + NoItemsEdit: TEdit; + NoCasesEdit: TEdit; + MeanEdit: TEdit; + SDEdit: TEdit; + RelEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Options: TRadioGroup; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure MeanEditKeyPress(Sender: TObject; var Key: char); + procedure NoCasesEditKeyPress(Sender: TObject; var Key: char); + procedure NoItemsEditKeyPress(Sender: TObject; var Key: char); + procedure RelEditKeyPress(Sender: TObject; var Key: char); + procedure ResetBtnClick(Sender: TObject); + procedure SDEditKeyPress(Sender: TObject; var Key: char); + private + { private declarations } + public + { public declarations } + end; + +var + TestGenFrm: TTestGenFrm; + +implementation + +{ TTestGenFrm } + +procedure TTestGenFrm.ResetBtnClick(Sender: TObject); +begin + Options.ItemIndex := 0; + NoItemsEdit.Text := ''; + NoCasesEdit.Text := ''; + MeanEdit.Text := ''; + SDEdit.Text := ''; + RelEdit.Text := ''; + NoItemsEdit.SetFocus; +end; + +procedure TTestGenFrm.SDEditKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then RelEdit.SetFocus; +end; + +procedure TTestGenFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TTestGenFrm.ComputeBtnClick(Sender: TObject); +Var + test_var, true_var, total_item_var, true_item_var : double; + error_item_var, true_score, reliability, tempmean : double; + test_stddev, test_mean, X, error_score : double; + random_mean : DblDyneVec; + i, k, no_cases, no_items, itemtype, col : integer; + outline : string; + +begin + if ((NoCases > 0) or (NoVariables > 0)) then + begin + ShowMessage('You must first close the current file.'); + exit; + end; + + itemtype := Options.ItemIndex; // 0 = T-F, 1 = continuous + test_stddev := StrToFloat(SDEdit.Text); + test_var := test_stddev * test_stddev; + reliability := StrToFloat(RelEdit.Text); + true_var := test_var * reliability; + no_items := StrToInt(NoItemsEdit.Text); + no_cases := StrToInt(NoCasesEdit.Text); + test_mean := StrToFloat(MeanEdit.Text); + total_item_var := (test_var / no_items) * (1.0 - + ((no_items - 1) / no_items) * reliability); + true_item_var := total_item_var * reliability; + error_item_var := total_item_var - true_item_var; + tempmean := test_mean / no_items; + + SetLength(random_mean,no_items); + + OS3MainFrm.DataGrid.RowCount := no_cases + 1; +// OS3MainFrm.DataGrid.ColCount := no_items + 1; + NoVariables := 0; + NoCases := 0; + DictionaryFrm.DictGrid.ColCount := 8; + OS3MainFrm.DataGrid.ColCount := 2; + for i := 1 to no_items do + begin + col := i; + outline := format('Item%d',[i]); + DictionaryFrm.DictGrid.RowCount := i; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := outline; + OS3MainFrm.DataGrid.Cells[col,0] := outline; + end; + for i := 1 to no_cases do + begin + outline := format('CASE %d',[i]); + OS3MainFrm.DataGrid.Cells[0,i] := outline; + end; + for i := 0 to no_items-1 do + begin + random_mean[i] := RandG(tempmean,sqrt(total_item_var)); + end; + for k := 1 to no_cases do + begin + true_score := RandG(0.0,sqrt(true_var)); + true_score := true_score / no_items; + for i := 1 to no_items do + begin + error_score := RandG(0.0,sqrt(error_item_var)); + X := true_score + error_score + random_mean[i-1]; + if (itemtype = 0) then // dichotomous item + begin + if (X >= random_mean[i-1]) then X := 1.0 + else X := 0.0; + end; + if (itemtype = 0) then outline := format('%2.0f',[X]) + else outline := format('%6.4f',[X]); + OS3MainFrm.DataGrid.Cells[i,k] := outline; + end; // end item loop + end; // end case loop + + NoVariables := no_items; + NoCases := no_cases; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases); + OS3MainFrm.DataGrid.Row := 1; + OS3MainFrm.DataGrid.Col := 1; + OS3MainFrm.RowEdit.Text := IntToStr(no_cases); + OS3MainFrm.ColEdit.Text := IntToStr(no_items); + OS3MainFrm.FileNameEdit.Text := 'GenTest.LAZ'; + // clean up the heap + random_mean := nil; +end; + +procedure TTestGenFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MaxHeight := Height; + Constraints.MinHeight := Height; +end; + +procedure TTestGenFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TTestGenFrm.MeanEditKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then SDEdit.SetFocus; +end; + +procedure TTestGenFrm.NoCasesEditKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then MeanEdit.SetFocus; +end; + +procedure TTestGenFrm.NoItemsEditKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then NoCasesEdit.SetFocus; +end; + +procedure TTestGenFrm.RelEditKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then ComputeBtn.SetFocus; +end; + +initialization + {$I testgenunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/testscoreunit.lfm b/applications/lazstats/source/forms/analysis/measurement_programs/testscoreunit.lfm new file mode 100644 index 000000000..40eacde7c --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/testscoreunit.lfm @@ -0,0 +1,785 @@ +object TestScoreFrm: TTestScoreFrm + Left = 501 + Height = 543 + Top = 204 + Width = 641 + AutoSize = True + Caption = 'Test Scoring and Analysis' + ClientHeight = 543 + ClientWidth = 641 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 156 + Top = 338 + Width = 625 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 8 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 136 + ClientWidth = 621 + TabOrder = 3 + object FirstChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 287 + Caption = 'First data record is the scoring key' + OnClick = FirstChkClick + TabOrder = 0 + end + object SimultChk: TCheckBox + Left = 307 + Height = 19 + Top = 6 + Width = 302 + Caption = 'Simultaneous Multiple Regression' + TabOrder = 1 + end + object ReplaceChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 287 + Caption = 'Replace grid items with item scores' + TabOrder = 7 + end + object CorrsChk: TCheckBox + Left = 307 + Height = 19 + Top = 27 + Width = 302 + Caption = 'Intercorrelations Matrix' + TabOrder = 2 + end + object AddChk: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 287 + Caption = 'Add Test scores to the grid' + TabOrder = 8 + end + object PlotChk: TCheckBox + Left = 307 + Height = 19 + Top = 48 + Width = 302 + Caption = 'Plot Total Score Distribution' + TabOrder = 3 + end + object ListChk: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 287 + Caption = 'List test scores' + TabOrder = 9 + end + object DescChk: TCheckBox + Left = 307 + Height = 19 + Top = 69 + Width = 302 + Caption = 'Means, Variances, Standard Deviations' + TabOrder = 4 + end + object AlphaChk: TCheckBox + Left = 12 + Height = 19 + Top = 90 + Width = 287 + Caption = 'Cronbach Alpha Reliability' + TabOrder = 10 + end + object HoytChk: TCheckBox + Left = 307 + Height = 19 + Top = 90 + Width = 302 + Caption = 'Hoyt''s Intraclass Reliability Estimates' + TabOrder = 5 + end + object StepChk: TCheckBox + Left = 12 + Height = 19 + Top = 111 + Width = 287 + Caption = 'Stepwise KR#20 Reliability' + TabOrder = 11 + end + object MeansPlotChk: TCheckBox + Left = 307 + Height = 19 + Top = 111 + Width = 302 + Caption = 'Plot Item Means' + TabOrder = 6 + end + end + object GroupBox2: TGroupBox + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 411 + Height = 215 + Top = 8 + Width = 221 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 9 + Caption = 'Item Scoring' + ClientHeight = 195 + ClientWidth = 217 + TabOrder = 1 + object Label7: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrCenter + Left = 16 + Height = 15 + Top = 8 + Width = 74 + BorderSpacing.Left = 16 + Caption = 'Item Number:' + ParentColor = False + end + object Label8: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = ItemScroll + AnchorSideTop.Side = asrCenter + Left = 16 + Height = 15 + Top = 33 + Width = 31 + BorderSpacing.Left = 16 + Caption = 'Down' + ParentColor = False + end + object Label9: TLabel + AnchorSideTop.Control = ItemScroll + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 194 + Height = 15 + Top = 33 + Width = 15 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Up' + ParentColor = False + end + object Label10: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = ItemScroll + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 15 + Top = 57 + Width = 193 + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'NOTE: 1 to 5 responses are permitted' + ParentColor = False + end + object Label11: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = RespNoEdit + AnchorSideTop.Side = asrCenter + Left = 16 + Height = 15 + Top = 92 + Width = 127 + BorderSpacing.Left = 16 + Caption = 'Item Response Number:' + ParentColor = False + end + object Label12: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = ResponseEdit + AnchorSideTop.Side = asrCenter + Left = 16 + Height = 15 + Top = 119 + Width = 53 + BorderSpacing.Left = 16 + Caption = 'Response:' + ParentColor = False + end + object Label13: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = ScoreEdit + AnchorSideTop.Side = asrCenter + Left = 16 + Height = 15 + Top = 146 + Width = 78 + BorderSpacing.Left = 16 + Caption = 'Score (Weight)' + ParentColor = False + end + object Label14: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = ResponseScroll + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 16 + Height = 15 + Top = 171 + Width = 31 + BorderSpacing.Left = 16 + BorderSpacing.Right = 8 + Caption = 'Down' + ParentColor = False + end + object Label15: TLabel + AnchorSideTop.Control = ResponseScroll + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 194 + Height = 15 + Top = 171 + Width = 15 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Up' + ParentColor = False + end + object ItemNoEdit: TEdit + AnchorSideTop.Control = GroupBox2 + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 157 + Height = 23 + Top = 4 + Width = 52 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + TabOrder = 0 + Text = '1' + end + object ItemScroll: TScrollBar + AnchorSideLeft.Control = Label8 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ItemNoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Label9 + Left = 51 + Height = 18 + Top = 31 + Width = 139 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 + Min = 1 + PageSize = 0 + Position = 1 + TabOrder = 1 + OnChange = ItemScrollChange + end + object RespNoEdit: TEdit + AnchorSideTop.Control = Label10 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 157 + Height = 23 + Top = 88 + Width = 52 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + TabOrder = 2 + Text = '1' + end + object ResponseEdit: TEdit + AnchorSideLeft.Control = Label12 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = RespNoEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 77 + Height = 23 + Top = 115 + Width = 132 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + TabOrder = 3 + end + object ScoreEdit: TEdit + AnchorSideTop.Control = ResponseEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 157 + Height = 23 + Top = 142 + Width = 52 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + TabOrder = 4 + Text = '1' + end + object ResponseScroll: TScrollBar + AnchorSideLeft.Control = Label14 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ScoreEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Label15 + Left = 55 + Height = 18 + Top = 169 + Width = 135 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 + BorderSpacing.Bottom = 8 + Max = 5 + Min = 1 + PageSize = 0 + Position = 1 + TabOrder = 5 + OnChange = ResponseScrollChange + end + end + object GroupBox3: TGroupBox + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = GroupBox2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 411 + Height = 93 + Top = 239 + Width = 222 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + Caption = 'Obtain Total Score By:' + ClientHeight = 73 + ClientWidth = 218 + TabOrder = 2 + object Label6: TLabel + AnchorSideLeft.Control = FractEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = FractEdit + AnchorSideTop.Side = asrCenter + Left = 168 + Height = 15 + Top = 27 + Width = 34 + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'wrong' + ParentColor = False + end + object NoCorBtn: TRadioButton + AnchorSideLeft.Control = GroupBox3 + AnchorSideTop.Control = GroupBox3 + Left = 12 + Height = 19 + Top = 4 + Width = 106 + BorderSpacing.Left = 12 + BorderSpacing.Top = 4 + Caption = 'Number Correct' + TabOrder = 0 + end + object FractWrongBtn: TRadioButton + AnchorSideLeft.Control = GroupBox3 + AnchorSideTop.Control = NoCorBtn + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 25 + Width = 109 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + Caption = 'No. Correct - 1 / ' + TabOrder = 1 + end + object FractEdit: TEdit + AnchorSideLeft.Control = FractWrongBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = FractWrongBtn + AnchorSideTop.Side = asrCenter + Left = 123 + Height = 23 + Top = 23 + Width = 37 + Alignment = taRightJustify + BorderSpacing.Left = 2 + TabOrder = 2 + Text = '1' + end + object SumRespBtn: TRadioButton + AnchorSideLeft.Control = GroupBox3 + AnchorSideTop.Control = FractWrongBtn + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 46 + Width = 170 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 8 + Caption = 'Sum of Weighted Responses' + TabOrder = 3 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 340 + Height = 25 + Top = 510 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 4 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 406 + Height = 25 + Top = 510 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 5 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 480 + Height = 25 + Top = 510 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 568 + Height = 25 + Top = 510 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 7 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = GroupBox3 + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 322 + Top = 8 + Width = 387 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 + BevelOuter = bvNone + ClientHeight = 322 + ClientWidth = 387 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ItemList + AnchorSideTop.Control = Panel1 + Left = 215 + Height = 15 + Top = 0 + Width = 76 + Caption = 'Selected Items' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = LastNameEdit + AnchorSideTop.Control = LastInBtn + AnchorSideBottom.Control = LastNameEdit + Left = 215 + Height = 15 + Top = 172 + Width = 59 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Last Name:' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = FirstNameEdit + AnchorSideBottom.Control = FirstNameEdit + Left = 215 + Height = 15 + Top = 228 + Width = 60 + Anchors = [akLeft, akBottom] + Caption = 'First Name:' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = IDNoEdit + AnchorSideBottom.Control = IDNoEdit + Left = 215 + Height = 15 + Top = 282 + Width = 58 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'ID Number' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 305 + Top = 17 + Width = 171 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 179 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 179 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object LastInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Label4 + Left = 179 + Height = 28 + Top = 184 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = LastInBtnClick + Spacing = 0 + TabOrder = 4 + end + object FirstInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Label5 + Left = 179 + Height = 28 + Top = 238 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = FirstInBtnClick + Spacing = 0 + TabOrder = 6 + end + object IDInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 179 + Height = 28 + Top = 294 + Width = 28 + Anchors = [akLeft, akBottom] + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = IDInBtnClick + Spacing = 0 + TabOrder = 8 + end + object ItemList: TListBox + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = InBtn + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Label3 + Left = 215 + Height = 139 + Top = 17 + Width = 172 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 16 + ItemHeight = 0 + TabOrder = 3 + end + object LastNameEdit: TEdit + AnchorSideLeft.Control = LastInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = LastInBtn + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = LastInBtn + AnchorSideBottom.Side = asrBottom + Left = 215 + Height = 23 + Top = 189 + Width = 172 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + TabOrder = 5 + end + object FirstNameEdit: TEdit + AnchorSideLeft.Control = FirstInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = FirstInBtn + AnchorSideBottom.Side = asrBottom + Left = 215 + Height = 23 + Top = 243 + Width = 172 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + TabOrder = 7 + end + object IDNoEdit: TEdit + AnchorSideLeft.Control = IDInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = IDInBtn + AnchorSideBottom.Side = asrBottom + Left = 215 + Height = 23 + Top = 299 + Width = 172 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + TabOrder = 9 + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 494 + Width = 641 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/measurement_programs/testscoreunit.pas b/applications/lazstats/source/forms/analysis/measurement_programs/testscoreunit.pas new file mode 100644 index 000000000..001b660ce --- /dev/null +++ b/applications/lazstats/source/forms/analysis/measurement_programs/testscoreunit.pas @@ -0,0 +1,1126 @@ +unit TestScoreUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MatrixLib, MainUnit, Globals, DataProcs, OutputUnit, FunctionsLib, + GraphLib, DictionaryUnit; + +type + + { TTestScoreFrm } + + TTestScoreFrm = class(TForm) + Bevel1: TBevel; + MeansPlotChk: TCheckBox; + HoytChk: TCheckBox; + DescChk: TCheckBox; + Panel1: TPanel; + PlotChk: TCheckBox; + CorrsChk: TCheckBox; + SimultChk: TCheckBox; + FirstChk: TCheckBox; + ReplaceChk: TCheckBox; + AddChk: TCheckBox; + ListChk: TCheckBox; + AlphaChk: TCheckBox; + StepChk: TCheckBox; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + InBtn: TBitBtn; + OutBtn: TBitBtn; + LastInBtn: TBitBtn; + FirstInBtn: TBitBtn; + IDInBtn: TBitBtn; + Label14: TLabel; + Label15: TLabel; + ScoreEdit: TEdit; + Label13: TLabel; + ResponseEdit: TEdit; + Label12: TLabel; + RespNoEdit: TEdit; + ItemNoEdit: TEdit; + FractEdit: TEdit; + GroupBox1: TGroupBox; + GroupBox2: TGroupBox; + GroupBox3: TGroupBox; + Label10: TLabel; + Label11: TLabel; + Label6: TLabel; + Label7: TLabel; + Label8: TLabel; + Label9: TLabel; + LastNameEdit: TEdit; + FirstNameEdit: TEdit; + IDNoEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + ItemList: TListBox; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + NoCorBtn: TRadioButton; + FractWrongBtn: TRadioButton; + ItemScroll: TScrollBar; + ResponseScroll: TScrollBar; + SumRespBtn: TRadioButton; + VarList: TListBox; + procedure CancelBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FirstChkClick(Sender: TObject); + procedure FirstInBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure IDInBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure ItemScrollChange(Sender: TObject); + procedure LastInBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure ResponseScrollChange(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + NoItems : integer; + NoSelected : integer; + NCases : integer; // count of good records (not counting key if included) + ColNoSelected : IntDyneVec; + ColLabels, RowLabels : StrDyneVec; + Responses : array[1..5] of StrDyneVec; + RespWghts : array[1..5] of DblDyneVec; + Means, Variances, StdDevs : DblDyneVec; + CorMat : DblDyneMat; // correlations among items and total score + Data : DblDyneMat; //store item scores and total score + IDCol, FNameCol, LNameCol : integer; + MaxRespNo : integer; + procedure ItemScores(Sender: TObject); + procedure ScoreReport(Sender: TObject); + procedure Alpha(Sender: TObject); + procedure Cors(Sender: TObject); + procedure SimMR(Sender: TObject); + procedure Hoyt(Sender: TObject); + procedure StepKR(Sender: TObject); + procedure PlotScores(Sender: TObject); + procedure PlotMeans(Sender: TObject); + + public + { public declarations } + end; + +var + TestScoreFrm: TTestScoreFrm; + +implementation + +uses + Math; + +{ TTestScoreFrm } + +procedure TTestScoreFrm.ResetBtnClick(Sender: TObject); +VAR i, j : integer; +begin + ItemScroll.Min := 1; + ResponseScroll.Min := 1; + ItemScroll.Position := 1; + ResponseScroll.Position := 1; + InBtn.Enabled := true; + OutBtn.Enabled := false; + VarList.Items.Clear; + ItemList.Items.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + ItemNoEdit.Text := '1'; + RespNoEdit.Text := '1'; + ResponseEdit.Text := '1'; + ScoreEdit.Text := '1'; + FractEdit.Text := '4'; + LastNameEdit.Text := ''; + FirstNameEdit.Text := ''; + IDNoEdit.Text := ''; + NoCorBtn.Checked := true; + ReplaceChk.Checked := false; + AddChk.Checked := false; + ListChk.Checked := false; + AlphaChk.Checked := false; + SimultChk.Checked := false; + CorrsChk.Checked := false; + PlotChk.Checked := false; + DescChk.Checked := false; + FirstChk.Checked := true; + GroupBox2.Visible := false; + MaxRespNo := 0; + LastInBtn.Visible := true; + FirstInBtn.Visible := true; + IDInBtn.Visible := true; + StepChk.Checked := false; + HoytChk.Checked := false; + MeansPlotChk.Checked := false; + + //allocate space on heap + SetLength(ColNoSelected,NoVariables); + SetLength(ColLabels,NoVariables+1); + SetLength(RowLabels,NoVariables+1); + SetLength(Means,NoVariables+1); + SetLength(Variances,NoVariables+1); + SetLength(StdDevs,NoVariables+1); + SetLength(CorMat,NoVariables+2,NoVariables+2); + SetLength(Data,NoCases+1,NoVariables+2); + + for i := 1 to 5 do + begin + SetLength(RespWghts[i],NoVariables); + SetLength(Responses[i],NoVariables); + end; + for i := 1 to 5 do + begin + for j := 1 to NoVariables do + begin + RespWghts[i][j-1] := 1.0; + Responses[i][j-1] := '1'; + end; + end; +end; + +procedure TTestScoreFrm.ResponseScrollChange(Sender: TObject); +var + item, respno : integer; +begin + item := StrToInt(ItemNoEdit.Text); + if item <= 0 then exit; + respno := StrToInt(RespNoEdit.Text); + if respno > 5 then exit; // already at max + if respno > MaxRespNo then MaxRespNo := respno; + // save current response + Responses[respno][item-1] := ResponseEdit.Text; + RespWghts[respno][item-1] := StrToFloat(ScoreEdit.Text); + // display new position response + respno := ResponseScroll.Position; + RespNoEdit.Text := IntToStr(respno); + ResponseEdit.Text := Responses[respno][item-1]; + ScoreEdit.Text := FloatToStr(RespWghts[respno][item-1]); +end; + +procedure TTestScoreFrm.ReturnBtnClick(Sender: TObject); +begin + CancelBtnClick(self); +end; + +procedure TTestScoreFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TTestScoreFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TTestScoreFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TTestScoreFrm.IDInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + if index < 0 then exit; + IDNoEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + IDInBtn.Visible := false; +end; + +procedure TTestScoreFrm.InBtnClick(Sender: TObject); +VAR i, index : integer; +begin + if VarList.ItemIndex < 0 then + begin + InBtn.Enabled := false; + exit; + end; + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + ItemList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + OutBtn.Enabled := true; + ItemScroll.Max := ItemList.Items.Count; +end; + +procedure TTestScoreFrm.ItemScrollChange(Sender: TObject); +var + item, respno : integer; +begin + item := StrToInt(ItemNoEdit.Text); + respno := StrToInt(RespNoEdit.Text); + if respno > MaxRespNo then MaxRespNo := respno; + // save last one + if (item <> ItemScroll.Position) then + begin + Responses[respno][item-1] := ResponseEdit.Text; + RespWghts[respno][item-1] := StrToFloat(ScoreEdit.Text); + end; + item := ItemScroll.Position; + ItemNoEdit.Text := IntToStr(item); + respno := 1; + ResponseScroll.Position := 1; // first response + RespNoEdit.Text := '1'; // default + ScoreEdit.Text := '1'; // default + // load previous one + ResponseEdit.Text := Responses[respno][item-1]; + ScoreEdit.Text := FloatToStr(RespWghts[respno][item-1]); +end; + +procedure TTestScoreFrm.LastInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + if index < 0 then exit; + LastNameEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + LastInBtn.Visible := false; +end; + +procedure TTestScoreFrm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := ItemList.ItemIndex; + if index < 0 then + begin + OutBtn.Enabled := false; + exit; + end; + VarList.Items.Add(ItemList.Items.Strings[index]); + ItemList.Items.Delete(index); + InBtn.Enabled := true; +end; + +procedure TTestScoreFrm.CancelBtnClick(Sender: TObject); +VAR i : integer; +begin + for i := 1 to 5 do + begin + Responses[i] := nil; + RespWghts[i] := nil; + end; + Data := nil; + CorMat := nil; + StdDevs := nil; + Variances := nil; + Means := nil; + RowLabels := nil; + ColLabels := nil; + ColNoSelected := nil; + + Close; +end; + +procedure TTestScoreFrm.ComputeBtnClick(Sender: TObject); +var + i, j, col, start, count : integer; + cellstring : string; +begin + OutputFrm.RichEdit.Clear; + NoItems := ItemList.Items.Count; + // Insure last item scoring definition is saved + if FirstChk.Checked = false then ItemScroll.Position := 1; + for i := 1 to NoItems do // items to analyze + begin + for j := 1 to NoVariables do // variables in grid + begin + cellstring := OS3MainFrm.DataGrid.Cells[j,0]; + if cellstring = ItemList.Items.Strings[i-1] then + begin // matched - save info + ColNoSelected[i-1] := j; + ColLabels[i-1] := cellstring; + RowLabels[i-1] := cellstring; + end; // end match + end; // next j + end; // next i + ColLabels[NoItems] := 'TOTAL'; + RowLabels[NoItems] := 'TOTAL'; + + for j := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[j,0]; + if cellstring = IDNoEdit.Text then IDCol := j; + if cellstring = LastNameEdit.Text then LNameCol := j; + if cellstring = FirstNameEdit.Text then FNameCol := j; + end; + + if FirstChk.Checked then // first record is the key + begin + for i := 1 to NoItems do + begin + col := ColNoSelected[i-1]; + Responses[1][i-1] := Trim(OS3MainFrm.DataGrid.Cells[col,1]); + RespWghts[1][i-1] := 1.0; + MaxRespNo := 1; + end; + end; + + // check to see if grid item values are numeric or string + // if numeric, insure that they are integers, not floating values + for i := 1 to NoItems do + begin + col := ColNoSelected[i-1]; + if isnumeric(OS3MainFrm.DataGrid.Cells[col,2]) then // second case + begin + if DictionaryFrm.DictGrid.Cells[5,col] <> '0' then + begin + ShowMessage('Sorry, you must format cell values with 0 decimal parts.'); + exit; + end; + end; + end; + + // now score the responses + ItemScores(self); + + // place item scores in grid if elected + if ReplaceChk.Checked then + begin + if FirstChk.Checked then start := 2 else start := 1; + count := 0; + for i := start to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + count := count + 1; + for j := 1 to NoItems do + begin + col := ColNoSelected[j-1]; + OS3MainFrm.DataGrid.Cells[col,i] := FloatToStr(Data[count-1,j-1]); + end; + end; + end; + + // add total to grid if elected + if AddChk.Checked then + begin + cellstring := 'TOTAL'; + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,NoVariables] := cellstring; + OS3MainFrm.DataGrid.Cells[NoVariables,0] := cellstring; + DictionaryFrm.DictGrid.Cells[1,col] := cellstring; + count := 0; + if FirstChk.Checked then start := 2 else start := 1; + for i := start to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + count := count + 1; + col := NoVariables; + OS3MainFrm.DataGrid.Cells[col,i] := FloatToStr(Data[count-1,NoItems]); + end; + end; + + // list the scores if elected + if ListChk.Checked then ScoreReport(self); + + // get Cronbach Alpha reliability estimate if elected + if AlphaChk.Checked then Alpha(self); + + // get intraclass reliabilities (Hoyt) if elected + if HoytChk.Checked then Hoyt(self); + + // get step kr#20 if elected + if StepChk.Checked then StepKR(self); + + // get interitem correlation matrix if elected + if CorrsChk.Checked then Cors(self); + + // Get simultaneous multiple regressions if elected + if SimultChk.Checked then SimMR(self); + + // plot subject scores if elected + if PlotChk.Checked then PlotScores(self); + + // Plot item means if elected + if MeansPlotChk.Checked then PlotMeans(self); +end; + +procedure TTestScoreFrm.FirstChkClick(Sender: TObject); +begin + if FirstChk.Checked then GroupBox2.Visible := false else + GroupBox2.Visible := true; +end; + +procedure TTestScoreFrm.FirstInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + if index < 0 then exit; + FirstNameEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + FirstInBtn.Visible := false; +end; + + +procedure TTestScoreFrm.ItemScores(Sender: TObject); +var + start, i, j, k, count, col : integer; + score, denom, fract : double; + response : string; + +begin + if FirstChk.Checked then start := 2 else start := 1; + count := 0; + for i := start to NoCases do + begin + score := 0.0; + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + count := count + 1; + for j := 1 to NoItems do + begin + col := ColNoSelected[j-1]; + response := Trim(OS3MainFrm.DataGrid.Cells[col,i]); + for k := 1 to MaxRespNo do + begin + if (response = Responses[k][j-1])then + begin + if SumRespBtn.Checked = true then + begin + score := score + RespWghts[k][j-1]; + Data[count-1,j-1] := RespWghts[k][j-1]; + end; + if NoCorBtn.Checked = true then + begin + score := score + 1; + Data[count-1,j-1] := 1; + end; + if FractWrongBtn.Checked = true then + begin + denom := StrToFloat(FractEdit.Text); + fract := 1.0 / denom; + score := score + RespWghts[k][j-1] - (fract * RespWghts[k][j-1]); + Data[count-1,j-1] :=RespWghts[k][j-1] - (fract * RespWghts[k][j-1]); + end; + end; + end; + end; // next item in scale + Data[count-1,NoItems] := score; + end; // next case + NCases := count; +end; + +procedure TTestScoreFrm.ScoreReport(Sender: TObject); +var + i, start, count, col : integer; + outline, namestr : string; + +begin + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('TEST SCORING REPORT'); + OutputFrm.RichEdit.Lines.Add(''); + if FirstChk.Checked then start := 2 else start := 1; + outline := ''; + if IDNoEdit.Text <> '' then outline := outline + 'PERSON ID NUMBER ' + else outline := outline + 'CASE '; + if FirstNameEdit.Text <> '' then outline := outline + 'FIRST NAME '; + if LastNameEdit.Text <> '' then outline := outline + 'LAST NAME '; + outline := outline + 'TEST SCORE'; + OutputFrm.RichEdit.Lines.Add(outline); + count := 0; + for i := start to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + count := count + 1; + outline := ''; + if IDNoEdit.Text <> '' then + begin + col := IDCol; + namestr := Trim(OS3MainFrm.DataGrid.Cells[col,i]); + outline := outline + format('%16s ',[namestr]); + end + else + begin + namestr := Trim(OS3MainFrm.DataGrid.Cells[0,i]); + outline := outline + format('%-16s ',[namestr]); + end; + if FirstNameEdit.Text <> '' then + begin + col := FNameCol; + namestr := Trim(OS3MainFrm.DataGrid.Cells[col,i]); + outline := outline + format('%10s ',[namestr]); + end; + if LastNameEdit.Text <> '' then + begin + col := LNameCol; + namestr := Trim(OS3MainFrm.DataGrid.Cells[col,i]); + outline := outline + format('%10s ',[namestr]); + end; + outline := outline + format('%6.2f',[Data[count-1,NoItems]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; +end; + +procedure TTestScoreFrm.Alpha(Sender: TObject); +var + i, j : integer; + AlphaRel, SEMeas : double; + outline : string; + +begin + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(''); + AlphaRel := 0.0; + // get item variances + for j := 1 to NoItems + 1 do + begin + Variances[j-1] := 0.0; + Means[j-1] := 0.0; + end; + + for j := 1 to NoItems + 1 do + begin + for i := 1 to NCases do + begin + Variances[j-1] := Variances[j-1] + sqr(Data[i-1,j-1]); + Means[j-1] := Means[j-1] + Data[i-1,j-1]; + end; + end; + + for j := 1 to NoItems + 1 do + begin + Variances[j-1] := Variances[j-1] - (sqr(Means[j-1]) / NCases); + Variances[j-1] := Variances[j-1] / (NCases - 1); + Means[j-1] := Means[j-1] / NCases; + end; + + for i := 1 to NoItems do + begin + AlphaRel := AlphaRel + variances[i-1]; // sum of item variances + end; + AlphaRel := AlphaRel / variances[NoItems]; + AlphaRel := 1.0 - AlphaRel; + AlphaRel := (NoItems / (NoItems - 1.0)) * AlphaRel; + if AlphaRel > 1.0 then AlphaRel := 1.0; + SEMeas := sqrt(Variances[NoItems]) * sqrt(1.0 - AlphaRel); + outline := format('Alpha Reliability Estimate for Test = %6.4f S.E. of Measurement = %8.3f', + [AlphaRel,SEMeas]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; +end; + +procedure TTestScoreFrm.Cors(Sender: TObject); +var + i, j, k : integer; + title : string; +begin + OutputFrm.RichEdit.Clear; + for i := 1 to NoItems +1 do + begin + for j := 1 to NoItems + 1 do + begin + CorMat[i-1,j-1] := 0.0; + end; + Means[i-1] := 0.0; + Variances[i-1] := 0.0; + end; + + for i := 1 to NCases do + begin + for j := 1 to NoItems + 1 do + begin + for k := 1 to NoItems + 1 do + begin + CorMat[j-1,k-1] := Cormat[j-1,k-1] + (Data[i-1,j-1] * Data[i-1,k-1]); + end; + Means[j-1] := Means[j-1] + Data[i-1,j-1]; + Variances[j-1] := Variances[j-1] + sqr(Data[i-1,j-1]); + end; + end; + for i := 1 to NoItems + 1 do + begin + Variances[i-1] := Variances[i-1] - (sqr(Means[i-1]) / NCases); + Variances[i-1] := Variances[i-1] / (NCases - 1); + StdDevs[i-1] := sqrt(Variances[i-1]); + end; + for i := 1 to NoItems + 1 do + begin + for j := 1 to NoItems + 1 do + begin + CorMat[i-1,j-1] := CorMat[i-1,j-1] - (Means[i-1] * Means[j-1] / NCases); + CorMat[i-1,j-1] := CorMat[i-1,j-1] / (NCases - 1); + if (StdDevs[i-1] > 0) and (StdDevs[j-1] > 0) then + CorMat[i-1,j-1] := CorMat[i-1,j-1] / (StdDevs[i-1] * StdDevs[j-1]) + else begin + ShowMessage('ERROR! A zero variance found.'); + CorMat[i-1,j-1] := 99.99; + end; + end; + end; + for i := 1 to NoItems + 1 do Means[i-1] := Means[i-1] / NCases; + if CorrsChk.Checked then + begin + title := 'Item and Total Score Intercorrelations'; + MAT_PRINT(CorMat,NoItems + 1,NoItems + 1,title,RowLabels,ColLabels,NCases); + end; + if DescChk.Checked then + begin + title := 'Means'; + DynVectorPrint(means,NoItems+1,title,ColLabels,NCases); + title := 'Variances'; + DynVectorPrint(variances,NoItems+1,title,ColLabels,NCases); + title := 'Standard Deviations'; + DynVectorPrint(stddevs,NoItems+1,title,ColLabels,NCases); + end; + if (CorrsChk.Checked) or (DescChk.Checked) then OutputFrm.ShowModal; +end; + +procedure TTestScoreFrm.SimMR(Sender: TObject); +Label cleanup; +var + i, j : integer; + determinant, df1, df2, StdErr, x : double; + outline, valstring : string; + CorrMat : DblDyneMat; + ProdMat : DblDyneMat; + R2s : DblDyneVec; + W : DblDyneVec; + FProbs : DblDyneVec; + errorcode : boolean = false; + title : string; +begin + SetLength(CorrMat,NoVariables+1,NoVariables+1); + SetLength(R2s,NoVariables); + SetLength(W,NoVariables); + SetLength(FProbs,NoVariables); + SetLength(ProdMat,NoVariables+1,NoVariables+1); + + OutputFrm.RichEdit.Clear; + if CorrsChk.Checked = false then Cors(self); + determinant := 0.0; + for i := 0 to NoItems-1 do + for j := 0 to NoItems-1 do + CorrMat[i,j] := CorMat[i,j]; + Determ(CorrMat,NoItems,NoItems,determinant,errorcode); + if (determinant < 0.000001) then + begin + ShowMessage('ERROR! Matrix is singular!'); + goto cleanup; + end; + outline := format('Determinant of correlation matrix = %8.4f',[determinant]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + for i := 0 to NoItems-1 do + for j := 0 to NoItems-1 do + CorrMat[i,j] := CorMat[i,j]; + SVDinverse(CorrMat,NoItems); + + OutputFrm.RichEdit.Lines.Add('Multiple Correlation Coefficients for Each Variable'); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('%10s%8s%10s%10s%12s%5s%5s',['Variable','R','R2','F','Prob.>F','DF1','DF2']); + OutputFrm.RichEdit.Lines.Add(outline); + + df1 := NoItems - 1.0; + df2 := NCases - NoItems; + + for i := 0 to NoItems-1 do + begin // R squared values + R2s[i] := 1.0 - (1.0 / CorrMat[i,i]); + W[i] := (R2s[i] / df1) / ((1.0-R2s[i]) / df2); + FProbs[i] := probf(W[i],df1,df2); + valstring := format('%10s',[ColLabels[i]]); + outline := format('%10s%10.3f%10.3f%10.3f%10.3f%5.0f%5.0f', + [valstring,sqrt(R2s[i]),R2s[i],W[i],FProbs[i],df1,df2]); + OutputFrm.RichEdit.Lines.Add(outline); + for j := 0 to NoItems-1 do + begin // betas + ProdMat[i,j] := -CorrMat[i,j] / CorrMat[j,j]; + end; + end; + title := 'Betas in Columns'; + MAT_PRINT(ProdMat,NoItems,NoItems,title,RowLabels,ColLabels,NCases); + OutputFrm.RichEdit.Lines.Add('Standard Errors of Prediction'); + OutputFrm.RichEdit.Lines.Add('Variable Std.Error'); + for i := 0 to NoItems-1 do + begin + StdErr := (NCases-1) * Variances[i] * (1.0 / CorrMat[i,i]); + StdErr := sqrt(StdErr / (NCases - NoItems)); + valstring := format('%10s',[ColLabels[i]]); + outline := format('%10s%10.3f',[valstring,StdErr]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + + for i := 0 to NoItems-1 do + for j := 0 to NoItems-1 do + if (i <> j) then ProdMat[i,j] := ProdMat[i,j] * (StdDevs[j]/StdDevs[i]); + title := 'Raw Regression Coefficients'; + MAT_PRINT(ProdMat,NoItems,NoItems,title,RowLabels,ColLabels,NCases); + OutputFrm.RichEdit.Lines.Add('Variable Constant'); + for i := 0 to NoItems-1 do + begin + x := 0.0; + for j := 0 to NoItems-1 do + begin + if (i <> j) then x := x + (ProdMat[j,i] * Means[j]); + end; + x := Means[i] - x; + valstring := format('%10s',[ColLabels[i]]); + outline := format('%10s%10.3f',[valstring,x]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + +cleanup: + ProdMat := nil; + FProbs := nil; + W := nil; + R2s := nil; + CorrMat := nil; + + OutputFrm.ShowModal; +end; + +procedure TTestScoreFrm.Hoyt(Sender: TObject); +var + i, j: integer; + Hoyt1, Hoyt2, Hoyt3, Hoyt4, SEMeas1, SEMeas2, SEMeas3, SEMeas4 : double; + SSError, SSCases, SSItems, SSWithin, TotalSS, TotalX, Constant : double; + MSItems, MSWithin, MSTotal, MSCases, MSError, score, ItemTotal : double; + F1, F2, prob1, prob2, dfcases, dfwithin, dferror, dftotal : double; + dfitems : double; + outline : string; +begin + if CorrsChk.Checked = false then Cors(self); + OutputFrm.RichEdit.clear; + SSCases := 0.0; + SSItems := 0.0; + TotalSS := 0.0; + TotalX := 0.0; + for j := 1 to NoItems do + begin + ItemTotal := 0.0; + for i := 1 to NCases do //subject loop + begin + score := Data[i-1,j-1]; + ItemTotal := ItemTotal + score; + TotalSS := TotalSS + (score * score); + end; + TotalX := TotalX + ItemTotal; + SSItems := SSItems + (ItemTotal * ItemTotal) / NCases; + end; + for i := 1 to NCases do // subject loop + begin + score := Data[i-1,NoItems]; + SSCases := SSCases + (score * score); + end; + SSCases := SSCases / NoItems; + Constant := (TotalX * TotalX) / (NCases * NoItems); + SSCases := SSCases - Constant; + TotalSS := TotalSS - Constant; + SSWithin := TotalSS - SSCases; + SSItems := SSItems - Constant; + MSItems := SSItems / (NoItems - 1); + SSError := SSWithin - SSItems; + MSWithin := SSWithin / (NCases * (NoItems - 1)); + MSTotal := TotalSS / ((NCases * NoItems) - 1.0); + MSCases := SSCases / (NCases - 1.0); + MSError := SSError / ((NCases - 1.0) * (NoItems - 1.0)); + dfcases := NCases - 1; + dfitems := NoItems - 1; + dfwithin := NCases * (NoItems - 1); + dferror := (NCases - 1) * (NoItems - 1); + dftotal := (NCases * NoITems) - 1; + F1 := MSCases / MSError; + F2 := MSItems / MSError; + prob1 := probf(F1,dfcases,dferror); + prob2 := probf(F2,dfitems,dferror); + OutputFrm.RichEdit.Lines.Add('Analysis of Variance for Hoyt Reliabilities'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('SOURCE D.F. SS MS F PROB'); + outline := format('Subjects %3.0f %8.2f %8.2f %8.2f %8.2f', + [dfcases,SSCases,MSCases,F1,prob1]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Within %3.0f %8.2f %8.2f', + [dfwithin,SSWithin,MSWithin]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Items %3.0f %8.2f %8.2f %8.2f %8.2f', + [dfitems,SSItems,MSItems,F2,prob2]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Error %3.0f %8.2f %8.2f', + [dferror,SSerror,MSerror]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Total %3.0f %8.2f', + [dftotal,TotalSS, MSTotal]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + Hoyt1 := 1.0 - (MSWithin / MSCases); + Hoyt2 := (MSCases - MSError) / MSCases; + Hoyt4 := (MSCases - MSError) / + (MSCases + (NoItems-1.0)*MSError); + Hoyt3 := (MSCases - MSWithin) / + (MSCases + (NoItems-1.0) * MSWithin); + SEMeas1 := stddevs[NoItems] * sqrt(1.0 - Hoyt1); + outline := format('Hoyt Unadjusted Test Rel. for scale %s = %6.4f S.E. of Measurement = %8.3f', + [ColLabels[NoItems],Hoyt1,SEMeas1]); + OutputFrm.RichEdit.Lines.Add(outline); + SEMeas2 := stddevs[NoItems] * sqrt(1.0 - Hoyt2); + outline := format('Hoyt Adjusted Test Rel. for scale %s = %6.4f S.E. of Measurement = %8.3f', + [ColLabels[NoItems],Hoyt2,SEMeas2]); + OutputFrm.RichEdit.Lines.Add(outline); + SEMeas3 := stddevs[NoItems] * sqrt(1.0 - Hoyt3); + outline := format('Hoyt Unadjusted Item Rel. for scale %s = %6.4f S.E. of Measurement = %8.3f', + [ColLabels[NoItems],Hoyt3,SEMeas3]); + OutputFrm.RichEdit.Lines.Add(outline); + SEMeas4 := stddevs[NoItems] * sqrt(1.0 - Hoyt4); + outline := format('Hoyt Adjusted Item Rel. for scale %s = %6.4f S.E. of Measurement = %8.3f', + [ColLabels[NoItems],Hoyt4,SEMeas4]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; +end; + +procedure TTestScoreFrm.StepKR(Sender: TObject); +var + i, j, col : integer; + score, KR20, meanscore, scorevar, sumvars, hicor : double; + selected : IntDyneVec; + v1, v2, nselected, incount : integer; + invalues : IntDyneVec; + PtBis : DblDyneVec; + outline : string; + done : boolean; +begin + SetLength(selected,NoVariables); + SetLength(invalues,NoVariables); + SetLength(PtBis,NoVariables); + Cors(self); + OutputFrm.RichEdit.Clear; + v1 := 0; + v2 := 0; + nselected := NoItems; + for i := 1 to nselected do selected[i-1] := i; + // pick highest correlation for items to start + hicor := -1.0; + for i := 1 to nselected - 1 do + begin + for j := i + 1 to nselected do + begin + if CorMat[i-1,j-1] > hicor then + begin + hicor := CorMat[i-1,j-1]; + v1 := i; + v2 := j; + end; + end; + end; + invalues[0] := v1; // cor matrix col + invalues[1] := v2; // cor matrix row + incount := 2; + // now add items based on highest pt.bis. with subscores + done := false; + repeat + begin + meanscore := 0.0; + scorevar := 0.0; + sumvars := 0.0; + for j := 1 to nselected do PtBis[j-1] := 0.0; + // first get score for each subject + for i := 1 to NCases do + begin + score := 0; + for j := 1 to incount do + begin + col := selected[invalues[j-1]-1]; + score := score + Data[i-1,col-1]; + end; + meanscore := meanscore + score; + scorevar := scorevar + sqr(score); + for j := 1 to nselected do + begin + col := selected[j-1]; + PtBis[j-1] := PtBis[j-1] + (score * Data[i-1,col-1]); + end; + end; + scorevar := scorevar - (sqr(meanscore) / NCases); + scorevar := scorevar / (NCases - 1); + for j := 1 to nselected do + begin + if (Variances[j-1] > 0) and (scorevar > 0) then + begin + PtBis[j-1] := PtBis[j-1] - (meanscore * Means[j-1]); + PtBis[j-1] := PtBis[j-1] / (NCases - 1); + PtBis[j-1] := PtBis[j-1] / sqrt(Variances[j-1] * scorevar); + end else PtBis[j-1] := 0.0; + end; + meanscore := meanscore / NCases; + // get sum of item variances + for j := 1 to incount do sumvars := sumvars + Variances[invalues[j-1]-1]; + KR20 := (incount / (incount - 1)) * (1.0 - sumvars / scorevar); + outline := format('KR#20 = %6.4f for the test with mean = %6.3f and variance = %6.3f', + [KR20,meanscore, scorevar]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := 'Item Mean Variance Pt.Bis.r'; + OutputFrm.RichEdit.Lines.Add(outline); + for j := 1 to incount do + begin + outline := format('%3d %6.3f %6.3f %6.4f', + [selected[invalues[j-1]-1],Means[invalues[j-1]-1],Variances[invalues[j-1]-1],PtBis[invalues[j-1]-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + if incount = nselected then done := true else + begin + hicor := -1.0; + for j := 1 to incount do PtBis[invalues[j-1]-1] := -2.0; + for j := 1 to nselected do + begin + if PtBis[j-1] > hicor then + begin + v1 := j; + hicor := PtBis[j-1]; + end; + end; + incount := incount + 1; + invalues[incount-1] := v1; + end; + end; + until done; + OutputFrm.ShowModal; + + // cleanup + PtBis := nil; + invalues := nil; + selected := nil; +end; + + +procedure TTestScoreFrm.PlotScores(Sender: TObject); +var + rowvar : DblDyneVec; + totscrs : DblDyneVec; + i, j : integer; + temp : double; + +begin + SetLength(rowvar,NoCases); + SetLength(totscrs,NoCases); + // use rowvar to hold case no. + for i := 1 to NCases do rowvar[i-1] := i; + // use totscrs to hold total subject scores + for i := 1 to NCases do totscrs[i-1] := Data[i-1,NoItems]; + // sort into ascending order + for i := 1 to NCases - 1 do + begin + for j := i + 1 to NCases do + begin + if totscrs[i-1] > totscrs[j-1] then // swap + begin + temp := totscrs[j-1]; + totscrs[j-1] := totscrs[i-1]; + totscrs[i-1] := temp; + temp := rowvar[j-1]; + rowvar[j-1] := rowvar[i-1]; + rowvar[i-1] := temp; + end; + end; + end; + SetLength(GraphFrm.Ypoints,1,NoCases); + SetLength(GraphFrm.Xpoints,1,NoCases); + for i := 1 to NoCases do + begin + GraphFrm.Ypoints[0,i-1] := totscrs[i-1]; + GraphFrm.Xpoints[0,i-1] := rowvar[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NoCases; + GraphFrm.Heading := 'DISTRIBUTION OF TOTAL SCORES'; + GraphFrm.XTitle := 'Case'; + GraphFrm.YTitle := 'Score'; +// GraphFrm.Ypoints[1] := totscrs; +// GraphFrm.Xpoints[1] := rowvar; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := true; + GraphFrm.GraphType := 2; // 3d Vertical Bar Chart + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + + rowvar := nil; + totscrs := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + + +procedure TTestScoreFrm.PlotMeans(Sender: TObject); +var + rowvar : DblDyneVec; + i : integer; +begin + SetLength(rowvar,NoItems); + SetLength(GraphFrm.Ypoints,1,NoItems); + SetLength(GraphFrm.Xpoints,1,NoItems); + // use rowvar to hold variable no. + for i := 1 to NoItems do + begin + rowvar[i-1] := i; + GraphFrm.Xpoints[0,i-1] := i; + GraphFrm.Ypoints[0,i-1] := Means[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NoItems; + GraphFrm.Heading := 'ITEM MEANS'; + GraphFrm.XTitle := 'Item No.'; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := true; + GraphFrm.GraphType := 2; // 3d Vertical Bar Chart + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + + rowvar := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + + + +initialization + {$I testscoreunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/backregunit.lfm b/applications/lazstats/source/forms/analysis/multiple_regression/backregunit.lfm new file mode 100644 index 000000000..d5aa07168 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/backregunit.lfm @@ -0,0 +1,357 @@ +object BackRegFrm: TBackRegFrm + Left = 622 + Height = 437 + Top = 187 + Width = 454 + AutoSize = True + Caption = 'Stepwise Backward Multiple Regression' + ClientHeight = 437 + ClientWidth = 454 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ListBox1 + AnchorSideTop.Control = Owner + Left = 178 + Height = 15 + Top = 8 + Width = 127 + BorderSpacing.Top = 8 + Caption = 'Variables to be Analyzed' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = DepVar + AnchorSideTop.Control = Owner + Left = 338 + Height = 15 + Top = 8 + Width = 102 + BorderSpacing.Top = 8 + Caption = 'Dependent Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 220 + Top = 25 + Width = 108 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + Left = 133 + Height = 28 + Top = 26 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + Left = 133 + Height = 28 + Top = 56 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + Left = 124 + Height = 25 + Top = 120 + Width = 46 + Anchors = [akTop] + AutoSize = True + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 3 + end + object ListBox1: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepInBtn + AnchorSideBottom.Control = GroupBox1 + Left = 178 + Height = 220 + Top = 25 + Width = 116 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + TabOrder = 4 + end + object DepInBtn: TBitBtn + Left = 302 + Height = 28 + Top = 24 + Width = 28 + Anchors = [akTop] + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInBtnClick + Spacing = 0 + TabOrder = 5 + end + object DepOutBtn: TBitBtn + AnchorSideLeft.Control = DepInBtn + Left = 302 + Height = 28 + Top = 56 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutBtnClick + Spacing = 0 + TabOrder = 6 + end + object DepVar: TEdit + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 338 + Height = 23 + Top = 25 + Width = 108 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 7 + Text = 'DepVar' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 135 + Top = 253 + Width = 439 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 16 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 24 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 5 + ClientHeight = 115 + ClientWidth = 435 + TabOrder = 8 + object MatInChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 6 + Width = 222 + Caption = 'Get Data from a matrix file (max.=200)' + TabOrder = 0 + end + object MatSaveChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 27 + Width = 222 + Caption = 'Save the correlation matrix' + TabOrder = 1 + end + object CPChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 48 + Width = 222 + Caption = 'Show Cross-Products Matrix' + TabOrder = 2 + end + object CovChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 69 + Width = 222 + Caption = 'Show Variance-Covariance Matrix' + TabOrder = 3 + end + object CorrsChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 90 + Width = 222 + Caption = 'Show Intercorrelation Matrix' + TabOrder = 4 + end + object MeansChkBox: TCheckBox + Left = 262 + Height = 19 + Top = 6 + Width = 157 + Caption = 'Show Means' + TabOrder = 5 + end + object VarChkBox: TCheckBox + Left = 262 + Height = 19 + Top = 27 + Width = 157 + Caption = 'Show Variances' + TabOrder = 6 + end + object SDChkBox: TCheckBox + Left = 262 + Height = 19 + Top = 48 + Width = 157 + Caption = 'Show Standard Deviations' + TabOrder = 7 + end + object PartialsChkBox: TCheckBox + Left = 262 + Height = 19 + Top = 69 + Width = 157 + Caption = 'Show Partial Correlations' + TabOrder = 8 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 153 + Height = 25 + Top = 404 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 9 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 219 + Height = 25 + Top = 404 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 10 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 293 + Height = 25 + Top = 404 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 11 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 381 + Height = 25 + Top = 404 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 12 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 388 + Width = 454 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object OpenDialog1: TOpenDialog + left = 216 + top = 48 + end + object SaveDialog1: TSaveDialog + left = 216 + top = 136 + end +end diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/backregunit.pas b/applications/lazstats/source/forms/analysis/multiple_regression/backregunit.pas new file mode 100644 index 000000000..655bbc15b --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/backregunit.pas @@ -0,0 +1,438 @@ +unit BackRegUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, Math, + Globals, MainDM, MainUnit, MatrixLib, OutputUnit, FunctionsLib, DataProcs; + +type + + { TBackRegFrm } + + TBackRegFrm = class(TForm) + Bevel1: TBevel; + OpenDialog1: TOpenDialog; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + InBtn: TBitBtn; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + DepInBtn: TBitBtn; + DepOutBtn: TBitBtn; + MatInChkBox: TCheckBox; + MatSaveChkBox: TCheckBox; + CPChkBox: TCheckBox; + CovChkBox: TCheckBox; + CorrsChkBox: TCheckBox; + MeansChkBox: TCheckBox; + SaveDialog1: TSaveDialog; + VarChkBox: TCheckBox; + SDChkBox: TCheckBox; + PartialsChkBox: TCheckBox; + DepVar: TEdit; + GroupBox1: TGroupBox; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + ListBox1: TListBox; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure CancelBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure DepInBtnClick(Sender: TObject); + procedure DepOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + BackRegFrm: TBackRegFrm; + +implementation + +{ TBackRegFrm } + +procedure TBackRegFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + ListBox1.Clear; + for i := 1 to NoVariables do + begin + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + end; + InBtn.Enabled := true; + OutBtn.Enabled := false; + CPChkBox.Checked := false; + CovChkBox.Checked := false; + CorrsChkBox.Checked := true; + MeansChkBox.Checked := true; + VarChkBox.Checked := false; + SDChkBox.Checked := true; + MatInChkBox.Checked := false; + MatSaveChkBox.Checked := false; + PartialsChkBox.Checked := false; + DepVar.Text := ''; + DepInBtn.Enabled := true; + DepOutBtn.Enabled := false; +end; + +procedure TBackRegFrm.ReturnBtnClick(Sender: TObject); +begin + Close; +end; + +procedure TBackRegFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TBackRegFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TBackRegFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TBackRegFrm.AllBtnClick(Sender: TObject); +VAR count, index : integer; +begin + count := VarList.Items.Count; + for index := 0 to count-1 do + begin + ListBox1.Items.Add(VarList.Items.Strings[index]); + end; + VarList.Clear; +end; + +procedure TBackRegFrm.CancelBtnClick(Sender: TObject); +begin + Close; +end; + +procedure TBackRegFrm.ComputeBtnClick(Sender: TObject); +Label CleanUp; +VAR + NoVars, NoIndepVars, i, j, NCases, StepNo : integer; + Index: integer; + R2, determinant, stderrest, POut, LowestPartial : double; + errorcode : integer; + errcode : boolean; + filename : string; + cellstring, outline: string; + Corrs : DblDyneMat; + Means : DblDyneVec; + Variances : DblDyneVec; + StdDevs : DblDyneVec; + ColNoSelected : IntDyneVec; + title : string; + RowLabels : StrDyneVec; + ColLabels : StrDyneVec; + InverseMat : DblDyneMat; + ProdMat : DblDyneMat; + CorrMat : DblDyneMat; + BetaWeights : DblDyneVec; + IndepIndex : IntDyneVec; + constant : double; +begin + if NoVariables = 0 then NoVariables := 200; + SetLength(Corrs,NoVariables+1,NoVariables+1); + SetLength(Means,NoVariables); + SetLength(Variances,NoVariables); + SetLength(StdDevs,NoVariables); + SetLength(RowLabels,NoVariables); + SetLength(ColLabels,NoVariables); + SetLength(InverseMat,NoVariables+1,NoVariables+1); + SetLength(ProdMat,NoVariables+1,NoVariables+1); + SetLength(CorrMat,NoVariables+1,NoVariables+1); + SetLength(BetaWeights,NoVariables); + SetLength(IndepIndex,NoVariables); + SetLength(ColNoSelected,NoVariables); + + OutputFrm.RichEdit.Clear; +// OutputFrm.RichEdit.ParaGraph.Alignment := taLeftJustify; + OutputFrm.RichEdit.Lines.Add('Step Backward Multiple Regression by Bill Miller'); + errcode := false; + errorcode := 0; + if MatInChkBox.Checked = true then + begin + OpenDialog1.Filter := 'FreeStat matrix files (*.MAT)|*.MAT|All files (*.*)|*.*'; + OpenDialog1.FilterIndex := 1; + if OpenDialog1.Execute then + begin + filename := OpenDialog1.FileName; + MATREAD(Corrs,NoVars,NoVars,Means,StdDevs,NCases,RowLabels,ColLabels,filename); + for i := 0 to NoVars-1 do + begin + Variances[i] := sqr(StdDevs[i]); + ColNoSelected[i] := i+1; + end; + DepVar.Text := RowLabels[NoVars-1]; + for i := 0 to NoVars-2 do ListBox1.Items.Add(RowLabels[i]); + CPChkBox.Checked := false; + CovChkBox.Checked := false; + MatSaveChkBox.Checked := false; + ShowMessage('NOTICE! Last variable in matrix is the dependent variable'); + end; + end; + if MatInChkBox.Checked = false then + begin + { get variable columns } + NoVars := ListBox1.Items.Count; + if NoVars < 1 then + begin + ShowMessage('ERROR! No variables selected.'); + goto CleanUp; + end; + for i := 1 to NoVars do + begin + cellstring := ListBox1.Items.Strings[i-1]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[i-1] := j; + RowLabels[i-1] := cellstring; + ColLabels[i-1] := cellstring; + end; + end; + end; + { get dependendent variable column } + if DepVar.Text = '' then + begin + ShowMessage('ERROR! No Dependent variable selected.'); + goto CleanUp; + end; + NoVars := NoVars + 1; + for j := 1 to NoVariables do + begin + if DepVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[NoVars-1] := j; + RowLabels[NoVars-1] := DepVar.Text; + ColLabels[NoVars-1] := DepVar.Text; + end; + end; + end; + POut := 1.0; + StepNo := 1; + while NoVars > 1 do + begin + OutputFrm.RichEdit.Lines.Add(''); + outline := format('----------------- STEP %3d ------------------',[StepNo]); + OutputFrm.RichEdit.Lines.Add(outline); + if CPChkBox.Checked = true then + begin + title := 'Cross-Products Matrix'; + GridXProd(NoVars,ColNoSelected,Corrs,errcode,NCases); + MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases); + end; + if CovChkBox.Checked = true then + begin + title := 'Variance-Covariance Matrix'; + GridCovar(NoVars,ColNoSelected,Corrs,Means,Variances, + StdDevs,errcode,NCases); + MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases); + end; + if MatInChkBox.Checked = false then + Correlations(NoVars,ColNoSelected,Corrs,Means,Variances, + StdDevs,errcode,NCases); + if CorrsChkBox.Checked = true then + begin + title := 'Product-Moment Correlations Matrix'; + MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases); + end; + if MatSaveChkBox.Checked = true then + begin + SaveDialog1.Filter := 'FreeStat matrix files (*.MAT)|*.MAT|All files (*.*)|*.*'; + SaveDialog1.FilterIndex := 1; + if SaveDialog1.Execute then + begin + filename := SaveDialog1.FileName; + MATSAVE(Corrs,NoVars,NoVars,Means,StdDevs,NCases,RowLabels,ColLabels,filename); + end; + MatSaveChkBox.Checked := false; // only save first one + end; + title := 'Means'; + if MeansChkBox.Checked = true then + DynVectorPrint(Means,NoVars,title,ColLabels,NCases); + title := 'Variances'; + if VarChkBox.Checked = true then + DynVectorPrint(Variances,NoVars,title,ColLabels,NCases); + title := 'Standard Deviations'; + if SDChkBox.Checked = true then + DynVectorPrint(StdDevs,NoVars,title,ColLabels,NCases); + if errorcode > 0 then + begin + ShowMessage('ERROR! A selected variable has no variability-run aborted.'); + goto CleanUp; + end; + + { get determinant of the correlation matrix } + determinant := 0.0; + for i := 1 to NoVars do + for j := 1 to NoVars do + CorrMat[i-1,j-1] := Corrs[i-1,j-1]; + Determ(CorrMat,NoVars,NoVars,determinant,errcode); + if (determinant < 0.000001) then + begin + ShowMessage('ERROR! Matrix is singular!'); +// goto cleanup; + end; + outline := format('Determinant of correlation matrix = %8.4f',[determinant]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + NoIndepVars := NoVars-1; + for i := 1 to NoIndepVars do IndepIndex[i-1] := i; + MReg2(NCases,NoVars,NoIndepVars,IndepIndex,corrs,InverseMat, + RowLabels,R2,BetaWeights, + Means,Variances,errorcode,StdErrEst,constant,POut,true, false,false, OutputFrm.RichEdit.Lines); + // Get partial correlation matrix + for i := 1 to NoVars do + for j := 1 to NoVars do + InverseMat[i-1,j-1] := Corrs[i-1,j-1]; + SVDinverse(InverseMat,NoVars); + for i := 1 to NoVars do + begin + for j := 1 to NoVars do + begin + ProdMat[i-1,j-1] := -(1.0 / sqrt(InverseMat[i-1,i-1])) * + InverseMat[i-1,j-1] * (1.0 / sqrt(InverseMat[j-1,j-1])); + end; + end; + LowestPartial := 1.0; + Index := NoIndepVars; + for i := 1 to NoIndepVars do + begin + BetaWeights[i-1] := ProdMat[i-1,NoVars-1]; + if abs(BetaWeights[i-1]) < LowestPartial then + begin + LowestPartial := abs(BetaWeights[i-1]); + Index := i; + end; + end; + if PartialsChkBox.Checked = true then + begin + title := 'Partial Correlations'; + DynVectorPrint(BetaWeights,NoIndepVars,title,ColLabels,NCases); + end; + OutputFrm.ShowModal; + + { eliminate variable with lowest partial } + if NoVars > 2 then + begin + outline := format('Variable %d (%s) eliminated',[Index,ColLabels[Index-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + for i := Index to NoVars-1 do + begin + ColNoSelected[i-1] := ColNoSelected[i]; + ColLabels[i-1] := ColLabels[i]; + RowLabels[i-1] := RowLabels[i]; + end; + NoVars := NoVars - 1; + StepNo := StepNo + 1; + end + else NoVars := 0; + end; + OutputFrm.ShowModal; + +CleanUp: + ColNoSelected := nil; + IndepIndex := nil; + BetaWeights := nil; + CorrMat := nil; + ProdMat := nil; + InverseMat := nil; + ColLabels := nil; + RowLabels := nil; + StdDevs := nil; + Variances := nil; + Means := nil; + Corrs := nil; + Close; +end; + +procedure TBackRegFrm.DepInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := ListBox1.ItemIndex; + DepVar.Text := ListBox1.Items.Strings[index]; + ListBox1.Items.Delete(index); + DepOutBtn.Enabled := true; + DepInBtn.Enabled := false; +end; + +procedure TBackRegFrm.DepOutBtnClick(Sender: TObject); +begin + ListBox1.Items.Add(DepVar.Text); + DepVar.Text := ''; + DepInBtn.Enabled := true; +end; + +procedure TBackRegFrm.InBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + ListBox1.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + OutBtn.Enabled := true; +end; + +procedure TBackRegFrm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := ListBox1.ItemIndex; + VarList.Items.Add(ListBox1.Items.Strings[index]); + ListBox1.Items.Delete(index); + InBtn.Enabled := true; +end; + +initialization + {$I backregunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/bestregunit.lfm b/applications/lazstats/source/forms/analysis/multiple_regression/bestregunit.lfm new file mode 100644 index 000000000..acfe95dbe --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/bestregunit.lfm @@ -0,0 +1,397 @@ +object BestRegFrm: TBestRegFrm + Left = 869 + Height = 433 + Top = 266 + Width = 474 + AutoSize = True + Caption = 'Best Combination Multiple Regression' + ClientHeight = 433 + ClientWidth = 474 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = BlockList + AnchorSideTop.Control = InBtn + Left = 268 + Height = 15 + Top = 105 + Width = 93 + Caption = 'Selected Variables' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = DepVar + AnchorSideBottom.Control = DepVar + Left = 268 + Height = 15 + Top = 33 + Width = 102 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = InProb + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 15 + Top = 224 + Width = 185 + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + Caption = 'Minimum Probability for Inclusion:' + ParentColor = False + WordWrap = True + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = InProb + Left = 8 + Height = 187 + Top = 25 + Width = 198 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 6 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepOutBtn + AnchorSideTop.Side = asrBottom + Left = 223 + Height = 28 + Top = 105 + Width = 28 + BorderSpacing.Top = 20 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 223 + Height = 28 + Top = 137 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = OutBtn + AnchorSideTop.Side = asrBottom + Left = 214 + Height = 25 + Top = 185 + Width = 46 + AutoSize = True + BorderSpacing.Top = 20 + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 3 + end + object BlockList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 268 + Height = 90 + Top = 122 + Width = 198 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 4 + end + object DepInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 223 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInBtnClick + Spacing = 0 + TabOrder = 5 + end + object DepOutBtn: TBitBtn + AnchorSideLeft.Control = DepInBtn + AnchorSideTop.Control = DepInBtn + AnchorSideTop.Side = asrBottom + Left = 223 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutBtnClick + Spacing = 0 + TabOrder = 6 + end + object DepVar: TEdit + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOutBtn + AnchorSideBottom.Side = asrBottom + Left = 268 + Height = 23 + Top = 50 + Width = 198 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 7 + Text = 'DepVar' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 135 + Top = 249 + Width = 459 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 5 + ClientHeight = 115 + ClientWidth = 455 + TabOrder = 8 + object CPChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 223 + Caption = 'Show Cross-Products Matrix' + TabOrder = 0 + end + object CovChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 223 + Caption = 'Show Deviation Cross-Products Matrix' + TabOrder = 1 + end + object CorrsChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 223 + Caption = 'Show Intercorrelations Matrix' + TabOrder = 2 + end + object MeansChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 223 + Caption = 'Show Means' + TabOrder = 3 + end + object VarChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 90 + Width = 223 + Caption = 'Show Variances' + TabOrder = 4 + end + object SDChkBox: TCheckBox + Left = 235 + Height = 19 + Top = 6 + Width = 208 + Caption = 'Show Standard Deviations' + TabOrder = 5 + end + object MatSaveChkBox: TCheckBox + Left = 235 + Height = 19 + Top = 27 + Width = 208 + Caption = 'Save Correlation Matrix' + TabOrder = 6 + end + object PredictChkBox: TCheckBox + Left = 235 + Height = 19 + Top = 48 + Width = 208 + Caption = 'Predictions, residuals, C.I''s to grid' + TabOrder = 7 + end + object MatInChkBox: TCheckBox + Left = 235 + Height = 19 + Top = 69 + Width = 208 + Caption = 'Enter Data from a Matrix' + TabOrder = 8 + end + object ComboShowChkBox: TCheckBox + Left = 235 + Height = 19 + Top = 90 + Width = 208 + Caption = 'Show Results for each Combination' + TabOrder = 9 + end + end + object InProb: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 201 + Height = 23 + Top = 220 + Width = 59 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 6 + TabOrder = 9 + Text = 'InProb' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 265 + Height = 25 + Top = 400 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 10 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 327 + Height = 25 + Top = 400 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 11 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 411 + Height = 25 + Top = 400 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 12 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 384 + Width = 474 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object OpenDialog1: TOpenDialog + left = 56 + top = 40 + end + object SaveDialog1: TSaveDialog + left = 56 + top = 104 + end +end diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/bestregunit.pas b/applications/lazstats/source/forms/analysis/multiple_regression/bestregunit.pas new file mode 100644 index 000000000..a00d85384 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/bestregunit.pas @@ -0,0 +1,826 @@ +unit BestRegUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + Globals, MainUnit, MatrixLib, OutputUnit, FunctionsLib, DataProcs; + + +type + + { TBestRegFrm } + + TBestRegFrm = class(TForm) + Bevel1: TBevel; + CPChkBox: TCheckBox; + ComboShowChkBox: TCheckBox; + CovChkBox: TCheckBox; + CorrsChkBox: TCheckBox; + MeansChkBox: TCheckBox; + VarChkBox: TCheckBox; + SDChkBox: TCheckBox; + MatSaveChkBox: TCheckBox; + PredictChkBox: TCheckBox; + MatInChkBox: TCheckBox; + InBtn: TBitBtn; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + DepInBtn: TBitBtn; + DepOutBtn: TBitBtn; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + DepVar: TEdit; + InProb: TEdit; + GroupBox1: TGroupBox; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + BlockList: TListBox; + OpenDialog1: TOpenDialog; + SaveDialog1: TSaveDialog; + VarList: TListBox; + + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure DepInBtnClick(Sender: TObject); + procedure DepOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + + + private + { private declarations } + FAutoSized: boolean; + pred_labels : StrDyneVec; + y_ptr, v : integer; + ii, jj : integer; + pointer : integer; + sets : integer; + selected : IntDyneVec; + max_set : IntDyneVec; + cross_prod : DblDyneMat; + ind_mat : DblDyneMat; + end_of_set : boolean; + all_done : boolean; + more_to_do : boolean; + no_predictors: integer; + last_set : integer; + first_pt : integer; + testval : integer; + sumx : DblDyneVec; + mean : DblDyneVec; + stddev : DblDyneVec; + variance : DblDyneVec; + xycross : DblDyneVec; + raw_b : DblDyneVec; + count : double; + b_zero : double; + stop_prob : double; + mult_R2 : double; + biggest_R2 : double; + last_R2 : double; + f_test : double; + t, beta : double; + ss_res : double; + ms_res : double; + ss_reg : double; + ms_reg : double; + df_reg : integer; + df_res : integer; + df1 : integer; + df_tot : integer; + prob_f : double; + ss_total : double; + seb : double; + R2_diff : double; + prout : double; + errorcode : integer; + errcode : boolean; + DepVarCol : integer; + RowLabels : StrDyneVec; + ColLabels : StrDyneVec; + ColNoSelected : IntDyneVec; + NCases : integer; + NoVars : integer; + + procedure Init; + procedure Regress(AReport: TStrings); + procedure BestSetStats(AReport: TStrings); + procedure BumpOne; + procedure StartSet; + procedure Reset; + + procedure UpdateBtnStates; + + public + { public declarations } + end; + +var + BestRegFrm: TBestRegFrm; + +implementation + +uses + Math; + +{ TBestRegFrm } + +procedure TBestRegFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + BlockList.Clear; + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + DepVar.Text := ''; + + CPChkBox.Checked := false; + CovChkBox.Checked := false; + CorrsChkBox.Checked := true; + MeansChkBox.Checked := true; + VarChkBox.Checked := false; + SDChkBox.Checked := true; + MatSaveChkBox.Checked := false; + PredictChkBox.Checked := false; + + UpdateBtnStates; +end; + +procedure TBestRegFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TBestRegFrm.ComputeBtnClick(Sender: TObject); +var + i, j: integer; + title: string; + cellstring: string; + filename: string; + R2: double; + StdErrEst: double; + IndepIndex: IntDyneVec; + constant: double; + lReport: TStrings; +begin + if InProb.Text = '' then + begin + InProb.SetFocus; + MessageDlg('Probability for inclusion not specified.', mtError, [mbOK], 0); + exit; + end; + + if not TryStrToFloat(InProb.Text, stop_prob) then // probability to include a block + begin + InProb.SetFocus; + MessageDlg('No number given for probability.', mtError, [mbOk], 0); + exit; + end; + + if MatInChkBox.Checked then + NoVariables := 200; + + SetLength(cross_prod, NoVariables+1, NoVariables+1); + SetLength(ind_mat, NoVariables+1, NoVariables+1); + SetLength(sumx, NoVariables); + SetLength(mean, NoVariables); + SetLength(stddev, NoVariables); + SetLength(variance, NoVariables); + SetLength(xycross, NoVariables); + SetLength(raw_b, NoVariables); + SetLength(RowLabels, NoVariables); + SetLength(ColLabels, NoVariables); + SetLength(IndepIndex, NoVariables); + SetLength(ColNoSelected, NoVariables); + SetLength(Selected, NoVariables); + SetLength(Max_Set, NoVariables); + SetLength(pred_labels, NoVariables); + + lReport := TStringList.Create; + try + lReport.Add('BEST COMBINATION MULTIPLEX REGRESSION by Bill Miller'); + errorcode := 0; + last_R2 := 0.0; + last_set := 0 ; + more_to_do := TRUE; + prout := 1.0; + + { get data } + if MatInChkBox.Checked then + begin + PredictChkBox.Checked := false; + MatSaveChkBox.Checked := false; + CPChkBox.Checked := false; + OpenDialog1.Filter := 'LazStats matrix files (*.mat)|*.mat;*.MAT|All files (*.*)|*.*'; + OpenDialog1.FilterIndex := 1; + if OpenDialog1.Execute then + begin + filename := OpenDialog1.FileName; + MatRead(cross_prod, NoVars, NoVars, Mean, stddev, NCases, RowLabels, ColLabels, filename); + for i := 1 to NoVars do + variance[i-1] := sqr(stddev[i-1]); + MessageDlg('Last variable in matrix is the dependent variable', mtInformation, [mbOK], 0); + lReport.Add('====================================================================='); + end; + + if CorrsChkBox.Checked then + begin + lReport.Add(''); + title := 'Product-Moment Correlations Matrix'; + MatPrint(cross_prod, NoVars, NoVars, title, RowLabels, ColLabels, NCases, lReport); + lReport.Add('====================================================================='); + end; + + if MeansChkBox.Checked then + begin + lReport.Add(''); + title := 'Means'; + DynVectorPrint(mean, NoVars, title, ColLabels, NCases, lReport); + lReport.Add('====================================================================='); + end; + + if VarChkBox.Checked then + begin + lReport.Add(''); + title := 'Variances'; + DynVectorPrint(variance, NoVars, title, ColLabels, NCases, lReport); + lReport.Add('====================================================================='); + end; + + if SDChkBox.Checked = true then + begin + lReport.Add(''); + title := 'Standard Deviations'; + DynVectorPrint(stddev, NoVars, title, ColLabels, NCases, lReport); + lReport.Add('====================================================================='); + end; + + DepVarCol := NoVars; + y_ptr := NoVars; + DepVar.Text := RowLabels[NoVars]; + + { convert correlations to deviation cross-products } + for i := 1 to NoVars do + for j := 1 to NoVars do + cross_prod[i-1,j-1] := cross_prod[i-1,j-1] * stddev[i-1] * stddev[j-1] * (NCases - 1); + end; + + if not MatInChkBox.Checked then + begin + { get independent item columns } + NoVars := BlockList.Items.Count; + if NoVars < 1 then + begin + MessageDlg('No independent variables selected.', mtError, [mbOK], 0); + exit; + end; + + for i := 1 to NoVars do + begin + cellstring := BlockList.Items.Strings[i-1]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[i-1] := j; + RowLabels[i-1] := cellstring; + ColLabels[i-1] := cellstring; + end; + end; + end; + + { get dependendent variable column } + if DepVar.Text = '' then + begin + MessageDlg('No dependent variable selected.', mtError, [mbOK], 0); + exit; + end; + DepVarCol := 0; + NoVars := NoVars + 1; + y_ptr := NoVars; + for j := 1 to NoVariables do + begin + if DepVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then + begin + DepVarCol := j; + ColNoSelected[NoVars-1] := j; + RowLabels[NoVars-1] := OS3MainFrm.DataGrid.Cells[j,0]; + ColLabels[NoVars-1] := RowLabels[NoVars-1]; + end; + end; + + Init; + + title := 'Cross-Products Matrix'; + GridXProd(NoVars,ColNoSelected,cross_prod,true,NCases); + for i := 1 to NoVars do + begin + sumx[i-1] := cross_prod[i-1,NoVars]; + mean[i-1] := sumx[i-1] / NCases; + variance[i-1] := cross_prod[i-1,i-1] - (sumx[i-1] * sumx[i-1] / NCases); + variance[i-1] := variance[i-1] / (NCases-1); + if variance[i-1] > 0 then + stddev[i-1] := sqrt(variance[i-1]) + else begin + MessageDlg('No variance for a variable!',mtError, [mbOK], 0); + exit; + end; + end; + + if CPChkBox.Checked then + begin + lReport.Add(''); + MatPrint(cross_prod, NoVars, NoVars, title, RowLabels, ColLabels, NCases, lReport); + lReport.Add('====================================================================='); + end; + + {get deviation cross-products matrix} + for i := 1 to NoVars do + for j := 1 to NoVars do + cross_prod[i-1,j-1] := cross_prod[i-1,j-1] - (mean[i-1] * mean[j-1] * NCases); + end; + + if CovChkBox.Checked then + begin + lReport.Add(''); + title := 'Deviation Cross-Products Matrix'; + MatPrint(cross_prod, NoVars, NoVars, title, RowLabels, ColLabels, NCases, lReport); + lReport.Add('====================================================================='); + end; + + v := NoVars; + no_predictors := v - 1; + ss_total := cross_prod[y_ptr-1,y_ptr-1]; + biggest_R2 := 0.0; + + { Find best single predictor } + sets := 1; + for j := 1 to no_predictors do + begin + selected[0] := j; + Regress(lReport); + end; + BestSetStats(lReport); + + { Find best combinations of 2 to no_predictors - 1 } + sets := 2; + while sets < no_predictors do + begin + end_of_set := FALSE; + StartSet(); + while not end_of_set do + begin + Regress(lReport); + BumpOne(); + end; + Regress(lReport); + BestSetStats(lReport); + inc(sets); + end; + dec(sets); // no. of predictors + + { Find regression with all of the predictors } + if more_to_do then + begin + sets := no_predictors; + for i := 1 to sets do selected[i-1] := i; + Regress(lReport); + BestSetStats(lReport); + end + else begin + lReport.Add(''); + lReport.Add('Last variable added failed entry test. Job ended.'); + end; + + if not MatInChkBox.Checked then + begin + { get correlation matrix and save if elected } + Correlations(NoVars, ColNoSelected, cross_prod, mean, variance, stddev, errcode, NCases); + if CorrsChkBox.Checked then + begin + title := 'Product-Moment Correlations Matrix'; + MatPrint(cross_prod, NoVars, NoVars, title, RowLabels, ColLabels, NCases, lReport); + lReport.Add('====================================================================='); + end; + + if MeansChkBox.Checked then + begin + title := 'Means'; + DynVectorPrint(mean, NoVars, title, ColLabels, NCases, lReport); + lReport.Add('====================================================================='); + end; + + if VarChkBox.Checked then + begin + title := 'Variances'; + DynVectorPrint(variance, NoVars, title, ColLabels, NCases, lReport); + lReport.Add('====================================================================='); + end; + + if SDChkBox.Checked then + begin + title := 'Standard Deviations'; + DynVectorPrint(stddev, NoVars, title, ColLabels, NCases, lReport); + lReport.Add('====================================================================='); + end; + + if MatSaveChkBox.Checked then + begin + SaveDialog1.Filter := 'LazStats matrix files (*.mat)|*.mat;*.MAT|All files (*.*)|*.*'; + SaveDialog1.FilterIndex := 1; + if SaveDialog1.Execute then + begin + filename := SaveDialog1.FileName; + MatSave(cross_prod, NoVars, NoVars, mean, stddev, NCases, RowLabels, ColLabels, filename); + end; + end; + + { add [predicted scores, residual scores, etc. to grid if options elected } + if PredictChkBox.Checked then + begin + for i := 1 to sets do + begin + ii := selected[i-1]; + IndepIndex[i-1] := ii; //ColNoSelected[ii]; + end; + prout := 1.0; + + MReg2(NCases, NoVars, sets, IndepIndex, cross_prod, ind_mat, + RowLabels, R2, raw_b, mean, variance, + errorcode, StdErrEst, constant,prout, true, false,false, lReport + ); + + Predict(ColNoSelected, NoVars, ind_mat, mean, stddev, + raw_b, StdErrEst, IndepIndex, sets + ); + end; + end; + + DisplayReport(lReport); + + finally + lReport.Free; + pred_labels := nil; + Max_Set := nil; + Selected := nil; + ColNoSelected := nil; + IndepIndex := nil; + ColLabels := nil; + RowLabels := nil; + raw_b := nil; + xycross := nil; + variance := nil; + stddev := nil; + mean := nil; + sumx := nil; + ind_mat := nil; + cross_prod := nil; + end; +end; + +procedure TBestRegFrm.Init; +var + i, j: integer; +begin + count := 0.0; + for i := 1 to NoVariables do + begin + sumx[i-1] := 0.0; + mean[i-1] := 0.0; + variance[i-1] := 0.0; + stddev[i-1] := 0.0; + for j := 1 to v do cross_prod[i-1,j-1] := 0.0; + end; +end; + +procedure TBestRegFrm.Regress(AReport: TStrings); +var + i, j: integer; + outline: string; +begin + b_zero := 0.0 ; + ss_reg := 0.0 ; + for i := 1 to sets do + raw_b[i-1] := 0.0 ; + + { Set up matrices of deviation cross_products to use } + for i := 1 to sets do + begin + ii := selected[i-1]; + xycross[i-1] := cross_prod[y_ptr-1,ii-1]; + for j := 1 to sets do + begin + jj := selected[j-1]; + ind_mat[i-1,j-1] := cross_prod[ii-1,jj-1]; + end; + end; + + SVDinverse(ind_mat, sets); + + for i := 1 to sets do + begin + ii := selected[i-1]; + for j := 1 to sets do + raw_b[i-1] := raw_b[i-1] + (ind_mat[i-1,j-1] * xycross[j-1]) ; + b_zero := b_zero + raw_b[i-1] * mean[ii-1]; + end; + b_zero := mean[y_ptr-1] - b_zero; + + { Get sum of squares for regression and multiple R } + for i := 1 to sets do + ss_reg := ss_reg + raw_b[i-1] * xycross[i-1]; + mult_R2 := ss_reg / ss_total; + + { Now, check to see if this R2 is largest. If so, save set } + if mult_R2 > biggest_R2 then + begin + biggest_R2 := mult_R2; + for i := 1 to sets do + max_set[i-1] := selected[i-1]; + end; + + { print out this combination for testing purposes } + if ComboShowChkBox.Checked then + begin + AReport.Add(' Set %d includes variables:', [sets]); + for i := 1 to sets do + AReport.Add('variable %d (%s)', [selected[i-1], ColLabels[selected[i-1]-1]]); + AReport.Add(''); + AReport.Add('Squared R: %.4f', [mult_R2]); + AReport.Add(''); + end; +end; + +procedure TBestRegFrm.BestSetStats(AReport: TStrings); +var + i, j: integer; + outline: string; +begin + AReport.Add(''); + AReport.Add('Variables entered in step %d', [sets]); + for i := 1 to sets do + begin + ii := max_set[i-1]; + selected[i-1] := max_set[i-1]; + AReport.Add('%2d %s',[max_set[i-1],ColLabels[ii-1]]); + end; + AReport.Add(''); + + Regress(AReport); + + AReport.Add('Squared Multiple Correlation: %.4f', [mult_r2]); + AReport.Add('Dependent variable: %s', [ColLabels[y_ptr-1]]); + AReport.Add(''); + AReport.Add('ANOVA for Regression Effects: '); + AReport.Add('SOURCE df SS MS F Prob'); + + df_reg := sets; + df_res := round(NCases) - sets - 1; + df_tot := round(NCases) - 1; + ms_reg := ss_reg / df_reg; + ss_res := ( 1.0 - mult_R2) * ss_total ; + ms_res := ss_res / df_res ; + f_test := ms_reg / ms_res ; + prob_f := probf(f_test, df_reg,df_res); + + { Get variance of b coefficients } + AReport.Add('Regression %3d %14.4f %14.4f %14.4f %14.4f', [df_reg, ss_reg, ms_reg, f_test, prob_f]); + AReport.Add('Residual %3d %14.4f %14.4f', [df_res, ss_res, ms_res]); + AReport.Add('Total %3d %14.4f', [df_tot, ss_total]); + AReport.Add(''); + + AReport.Add('Variables in the equation'); + AReport.Add('VARIABLE b s.e. b Beta t prob. t'); + for i := 1 to sets do + for j := 1 to sets do + ind_mat[i-1,j-1] := ind_mat[i-1,j-1] * ms_res ; + for i := 1 to sets do + begin + ii := selected[i-1]; + pred_labels[i-1] := ColLabels[ii-1]; + outline := Format('%16s %10.5f ',[ColLabels[ii-1],raw_b[i-1]]); + seb := sqrt(ind_mat[i-1,i-1]); + t := raw_b[i-1] / seb ; + f_test := t * t ; + prob_f := probf(f_test,1,df_res); + beta := raw_b[i-1] * stddev[ii-1] / stddev[y_ptr-1] ; + outline := outline + Format('%8.4f %8.4f %6.3f %6.4f', [seb,beta,t,prob_f]); + AReport.Add(outline); + end; + + AReport.Add('(Intercept) %10.5f',[b_zero]); + AReport.Add(''); + +{ MAT_PRINT(sets,ind_mat,pred_labels,'Variance-covariance matrix of b s');} + + { Now see if the gain was significant over last step } + df1 := sets - last_set ; + f_test := ((mult_R2 - last_R2 ) / df1 ) / ( (1.0 - mult_R2) / df_res) ; + prob_f := probf(f_test, df1,df_res); + if prob_f > stop_prob then more_to_do := FALSE ; + R2_diff := mult_R2 - last_R2 ; + AReport.Add('Increase in squared R for this step: %8.6f', [R2_diff]); + AReport.Add('F: %.4f with D.F. %d and %d with Probability %.4f', [f_test, df1, df_res, prob_f]); + AReport.Add(''); + AReport.Add('----------------------------------------------------------'); + + last_set := sets; + last_R2 := mult_R2; +end; + +procedure TBestRegFrm.BumpOne; +begin + if selected[first_pt-1] < no_predictors then + selected[first_pt-1] := selected[first_pt-1] + 1 + else + begin + all_done := false; + while not all_done do + begin + first_pt := first_pt -1; + if first_pt < 1 then + all_done := true + else + begin + selected[first_pt-1] := selected[first_pt-1] + 1; + if selected[first_pt-1] < selected[first_pt] then + begin + Reset(); + first_pt := pointer; + all_done := true; + end else + selected[first_pt-1] := selected[first_pt-1] - 1; + end; + end; + end; +end; + +procedure TBestRegFrm.StartSet; +var + i: integer; +begin + end_of_set := false; + for i := 1 to sets do + selected[i-1] := i; + first_pt := sets; + pointer := sets; +end; + +procedure TBestRegFrm.Reset; +var + i: integer; +begin + testval := no_predictors - sets + 1 ; + if (first_pt = 1) and (selected[first_pt-1] = testval) then + end_of_set := TRUE + else + for i := first_pt + 1 to sets do + selected[i-1] := selected[i-2] + 1; +end; + +procedure TBestRegFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + BlockList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TBestRegFrm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < BlockList.Items.Count do + begin + if BlockList.Selected[i] then + begin + VarList.Items.Add(BlockList.Items[i]); + BlockList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TBestRegFrm.AllBtnClick(Sender: TObject); +var + index: integer; +begin + for index := 0 to VarList.Items.Count-1 do + BlockList.Items.Add(VarList.Items[index]); + VarList.Clear; + UpdateBtnStates; +end; + +procedure TBestRegFrm.DepInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepVar.Text = '') then + begin + DepVar.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TBestRegFrm.DepOutBtnClick(Sender: TObject); +begin + if DepVar.Text <> '' then + begin + VarList.Items.Add(DepVar.Text); + DepVar.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TBestRegFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinHeight := AllBtn.Top + AllBtn.Height - VarList.Top; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TBestRegFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + InProb.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL); +end; + +procedure TBestRegFrm.UpdateBtnStates; +var + i: Integer; + lSelected: Boolean; +begin + lSelected := false; + for i:=0 to VarList.Items.Count - 1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + InBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to BlockList.Items.Count-1 do + if BlockList.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; + + DepInBtn.Enabled := (VarList.ItemIndex > -1) and (DepVar.Text <= ''); + DepOutBtn.Enabled := DepVar.Text <> ''; +end; + +procedure TBestRegFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + + +initialization + {$I bestregunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/blkmregunit.lfm b/applications/lazstats/source/forms/analysis/multiple_regression/blkmregunit.lfm new file mode 100644 index 000000000..cfec76588 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/blkmregunit.lfm @@ -0,0 +1,460 @@ +object BlkMregFrm: TBlkMregFrm + Left = 503 + Height = 451 + Top = 292 + Width = 465 + AutoSize = True + Caption = 'Block Entry Multiple Regression' + ClientHeight = 451 + ClientWidth = 465 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Bevel3 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 48 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = DepVar + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = DepVar + Left = 263 + Height = 15 + Top = 77 + Width = 102 + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = BlockList + Left = 263 + Height = 15 + Top = 144 + Width = 166 + Caption = 'Independent Var.s for this block' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = BlockNoEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = BlockNoEdit + Left = 8 + Height = 15 + Top = 12 + Width = 54 + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Block No. ' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = NextBlkBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = InProb + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = InProb + Left = 218 + Height = 15 + Top = 13 + Width = 187 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Right = 8 + Caption = 'Minimum Prob. to enter block:' + ParentColor = False + WordWrap = True + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 220 + Top = 65 + Width = 193 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + TabOrder = 3 + end + object DepInBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 217 + Height = 28 + Top = 69 + Width = 28 + Anchors = [akTop] + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInBtnClick + Spacing = 0 + TabOrder = 4 + end + object DepOutBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepInBtn + AnchorSideTop.Side = asrBottom + Left = 218 + Height = 28 + Top = 101 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = OutBtn + Left = 218 + Height = 28 + Top = 174 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 7 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = BlockList + AnchorSideTop.Side = asrCenter + Left = 218 + Height = 28 + Top = 206 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 8 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = OutBtn + AnchorSideTop.Side = asrBottom + Left = 209 + Height = 25 + Top = 244 + Width = 46 + AutoSize = True + BorderSpacing.Top = 10 + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 9 + end + object DepVar: TEdit + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOutBtn + AnchorSideBottom.Side = asrBottom + Left = 263 + Height = 23 + Top = 94 + Width = 194 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 6 + Text = 'DepVar' + end + object BlockList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 263 + Height = 119 + Top = 161 + Width = 194 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + TabOrder = 10 + end + object BlockNoEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + AnchorSideRight.Control = NextBlkBtn + Left = 70 + Height = 23 + Top = 8 + Width = 37 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 0 + Text = 'BlockNoEdit' + end + object NextBlkBtn: TButton + AnchorSideLeft.Control = BlockNoEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = BlockNoEdit + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 127 + Height = 25 + Top = 8 + Width = 83 + AutoSize = True + BorderSpacing.Left = 20 + BorderSpacing.Right = 8 + Caption = 'Next Block' + OnClick = NextBlkBtnClick + TabOrder = 1 + end + object InProb: TEdit + AnchorSideTop.Control = NextBlkBtn + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 413 + Height = 23 + Top = 9 + Width = 44 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 2 + Text = 'InProb' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 114 + Top = 288 + Width = 449 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 16 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 20 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 4 + ClientHeight = 94 + ClientWidth = 445 + TabOrder = 11 + object CPChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 6 + Width = 198 + Caption = 'Show Cross-Products Matrix' + TabOrder = 0 + end + object CovChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 27 + Width = 198 + Caption = 'Show Variance-Covariance Matrix' + TabOrder = 1 + end + object CorrsChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 48 + Width = 198 + Caption = 'Show Intercorrelation Matrix' + TabOrder = 2 + end + object MeansChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 69 + Width = 198 + Caption = 'Show Means' + TabOrder = 3 + end + object VarChkBox: TCheckBox + Left = 234 + Height = 19 + Top = 6 + Width = 195 + Caption = 'Show Variances' + TabOrder = 4 + end + object SDChkBox: TCheckBox + Left = 234 + Height = 19 + Top = 27 + Width = 195 + Caption = 'Show Standard Deviations' + TabOrder = 5 + end + object MatSaveChkBox: TCheckBox + Left = 234 + Height = 19 + Top = 48 + Width = 195 + Caption = 'Save Correlation Matrix' + TabOrder = 6 + end + object PredictChkBox: TCheckBox + Left = 234 + Height = 19 + Top = 69 + Width = 195 + Caption = 'Predictions,residuals,C.I.''s to Grid' + TabOrder = 7 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 164 + Height = 25 + Top = 418 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 12 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 230 + Height = 25 + Top = 418 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 13 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 304 + Height = 25 + Top = 418 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 14 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 392 + Height = 25 + Top = 418 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 15 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 402 + Width = 465 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Bevel3: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label5 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 12 + Top = 28 + Width = 465 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object SaveDialog1: TSaveDialog + left = 72 + top = 112 + end +end diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/blkmregunit.pas b/applications/lazstats/source/forms/analysis/multiple_regression/blkmregunit.pas new file mode 100644 index 000000000..c29206c11 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/blkmregunit.pas @@ -0,0 +1,510 @@ +unit BlkMRegUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + Globals, MainUnit, MatrixLib, OutputUnit, FunctionsLib, + DataProcs, DictionaryUnit; + + +type + + { TBlkMregFrm } + + TBlkMregFrm = class(TForm) + Bevel1: TBevel; + Bevel3: TBevel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + CPChkBox: TCheckBox; + CovChkBox: TCheckBox; + CorrsChkBox: TCheckBox; + MeansChkBox: TCheckBox; + SaveDialog1: TSaveDialog; + VarChkBox: TCheckBox; + SDChkBox: TCheckBox; + MatSaveChkBox: TCheckBox; + PredictChkBox: TCheckBox; + GroupBox1: TGroupBox; + InProb: TEdit; + Label5: TLabel; + NextBlkBtn: TButton; + DepInBtn: TBitBtn; + DepOutBtn: TBitBtn; + BlockNoEdit: TEdit; + InBtn: TBitBtn; + Label4: TLabel; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + DepVar: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + BlockList: TListBox; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure CancelBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure DepInBtnClick(Sender: TObject); + procedure DepOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure NextBlkBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + BlkVarCols : IntDyneMat; + NoBlocks : integer; + VarsInBlk : IntDyneVec; + NoVars : integer; + + public + { public declarations } + end; + +var + BlkMregFrm: TBlkMregFrm; + +implementation + +uses + Math; + +{ TBlkMregFrm } + +procedure TBlkMregFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + BlockList.Items.Clear; + VarList.Items.Clear; + BlockNoEdit.Text := '1'; + NoBlocks := 1; + for i := 1 to NoVariables do + begin + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + end; + InBtn.Enabled := true; + OutBtn.Enabled := false; + DepInBtn.Enabled := true; + DepOutBtn.Enabled := false; + CPChkBox.Checked := false; + CovChkBox.Checked := false; + CorrsChkBox.Checked := true; + MeansChkBox.Checked := true; + VarChkBox.Checked := false; + SDChkBox.Checked := true; + MatSaveChkBox.Checked := false; + PredictChkBox.Checked := false; +// HeteroChk.Checked := false; + NoVars := 0; + DepVar.Text := ''; + InProb.Text := '0.05'; + SetLength(BlkVarCols,NoVariables,NoVariables); + SetLength(VarsInBlk,NoVariables); +end; + +procedure TBlkMregFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TBlkMregFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); + if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TBlkMregFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TBlkMregFrm.AllBtnClick(Sender: TObject); +VAR count, index : integer; +begin + count := VarList.Items.Count; + for index := 0 to count-1 do + begin + BlockList.Items.Add(VarList.Items.Strings[index]); + end; + VarList.Clear; +end; + +procedure TBlkMregFrm.CancelBtnClick(Sender: TObject); +begin + if VarsInBlk <> nil then VarsInBlk := nil; + if BlkVarCols <> nil then BlkVarCols := nil; + Close; +end; + +procedure TBlkMregFrm.ComputeBtnClick(Sender: TObject); +Label CleanUp; +var + i, j, k, errorcode, NCases : integer; + NoIndepVars, DepVarCol, NEntered, StepNo : integer; + R2, df1, df2: double; + StdErrEst, F, FProbF, OldR2 : double; + pdf1, pdf2, probin, prout : double; + BetaWeights : DblDyneVec; + outline : string; + corrs : DblDyneMat; + Means : DblDyneVec; + Variances : DblDyneVec; + StdDevs : DblDyneVec; + title : string; + IndRowLabels : StrDyneVec; + IndColLabels : StrDyneVec; + IndepInverse : DblDyneMat; + IndepIndex : IntDyneVec; + Candidate : IntDyneVec; + filename : string; + ColEntered : IntDyneVec; + constant : double; + errcode : boolean = false; +begin + SetLength(corrs,NoVariables+1,NoVariables+1); + SetLength(IndepInverse,NoVariables,NoVariables); + SetLength(Means,NoVariables); + SetLength(Variances,NoVariables); + SetLength(StdDevs,NoVariables); + SetLength(IndepIndex,NoVariables); + SetLength(IndColLabels,NoVariables); + SetLength(IndRowLabels,NoVariables); + SetLength(BetaWeights,NoVariables); + SetLength(Candidate,NoVariables); + SetLength(ColEntered,NoVariables); + + NextBlkBtnClick(self); + probin := StrToFloat(InProb.Text); // probability to include a block + prout := 1.0; + OutputFrm.RichEdit.Clear; +// OutputFrm.RichEdit.ParaGraph.Alignment := taLeftJustify; + OutputFrm.RichEdit.Lines.Add('Block Entry Multiple Regression by Bill Miller'); + errorcode := 0; + + { get dependendent variable column } + if DepVar.Text = '' then + begin + ShowMessage('ERROR! No Dependent variable selected.'); + goto CleanUp; + end; + DepVarCol := 0; + NoVars := NoVars + 1; + for j := 1 to NoVariables do + if DepVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then DepVarCol := j; + R2 := 0.0; + OldR2 := 0.0; + pdf1 := 0.0; + pdf2 := 0.0; + for i := 1 to NoBlocks-1 do Candidate[i-1] := i; + { Now, complete Mult. Regs by adding blocks in each step } + for StepNo := 1 to NoBlocks-1 do + begin + NEntered := 0; + for i := 1 to StepNo do + begin + if (Candidate[StepNo-1] <> 0) then + begin + for j := 1 to VarsInBlk[i-1] do + begin + NEntered := NEntered + 1; + ColEntered[NEntered-1] := BlkVarCols[i-1,j-1]; + k := BlkVarCols[i-1,j-1]; + IndRowLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[k,0]; + IndColLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[k,0]; + end; + end; + end; + NEntered := NEntered + 1; // dependent variable last + ColEntered[NEntered-1] := DepVarCol; + IndRowLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[DepVarCol,0]; + IndColLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[DepVarCol,0]; + OutputFrm.RichEdit.Lines.Add(''); + outline := format('----------------- Trial Block %d Variables Added ------------------',[StepNo]); + OutputFrm.RichEdit.Lines.Add(outline); + if CPChkBox.Checked = true then + begin + title := 'Cross-Products Matrix'; + GridXProd(NEntered,ColEntered,Corrs,errcode,NCases); + MAT_PRINT(Corrs,NEntered,NEntered,title,IndRowLabels,IndColLabels,NCases); + end; + if CovChkBox.Checked = true then + begin + title := 'Variance-Covariance Matrix'; + GridCovar(NEntered,ColEntered,Corrs,Means,Variances, + StdDevs,errcode,NCases); + MAT_PRINT(Corrs,NEntered,NEntered,title,IndRowLabels,IndColLabels,NCases); + end; + Correlations(NEntered,ColEntered,Corrs,Means,Variances, + StdDevs,errcode,NCases); + if CorrsChkBox.Checked = true then + begin + title := 'Product-Moment Correlations Matrix'; + MAT_PRINT(Corrs,NEntered,NEntered,title,IndRowLabels,IndColLabels,NCases); + end; + title := 'Means'; + if MeansChkBox.Checked = true then + DynVectorPrint(Means,NEntered,title,IndColLabels,NCases); + title := 'Variances'; + if VarChkBox.Checked = true then + DynVectorPrint(Variances,NEntered,title,IndColLabels,NCases); + title := 'Standard Deviations'; + if SDChkBox.Checked = true then + DynVectorPrint(StdDevs,NEntered,title,IndColLabels,NCases); + if errorcode > 0 then + begin + ShowMessage('ERROR! A selected variable has no variability-run aborted.'); + goto CleanUp; + end; + NoIndepVars := NEntered - 1; + for i := 1 to NoIndepVars do IndepIndex[i-1] := i; + MReg2(NCases,NEntered,NoIndepVars,IndepIndex,corrs,IndepInverse, + IndRowLabels,R2,BetaWeights, + Means,Variances,errorcode,StdErrEst,constant,prout,true, false,false, OutputFrm.RichEdit.Lines); + outline := format('Increase in R Squared = %6.3f',[R2-OldR2]); + OutputFrm.RichEdit.Lines.Add(outline); + df1 := NoIndepVars - pdf1; + df2 := NCases - NoIndepVars - 1; + F := ((R2 - OldR2) / (1.0 - R2)) * df2 / df1; + FProbF := probf(F,df1,df2); + outline := format('F = %6.3f with probability = %6.3f',[F,FProbF]); + OutputFrm.RichEdit.Lines.Add(outline); + if FProbF < probin then + begin + outline := format('Block %d met entry requirements',[StepNo]); + OutputFrm.RichEdit.Lines.Add(outline); + end + else + begin + Candidate[StepNo-1] := 0; + NoIndepVars := NoIndepVars - VarsInBlk[StepNo-1]; + outline := format('Block %d did not meet entry requirements',[StepNo]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OldR2 := R2; + pdf1 := NoIndepVars; + end; + + { add [predicted scores, residual scores, etc. to grid if options elected } + if PredictChkBox.Checked = true then + begin + prout := 1.0; + Correlations(NEntered,ColEntered,Corrs,Means,Variances, + StdDevs,errcode,NCases); + + MReg2(NCases,NEntered,NoIndepVars,IndepIndex,corrs,IndepInverse, + IndRowLabels,R2,BetaWeights, + Means,Variances,errorcode,StdErrEst,constant,prout,true, false,false, OutputFrm.RichEdit.Lines); + + Predict(ColEntered, NEntered, IndepInverse, Means, StdDevs, + BetaWeights, StdErrEst, IndepIndex, NoIndepVars); + end; + +{ if HeteroChk.Checked = true then // do BPG test + begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('====================================================='); + OutputFrm.RichEdit.Lines.Add('Breusch-Pagan-Godfrey Test of Heteroscedasticity'); + OutputFrm.RichEdit.Lines.Add('====================================================='); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Auxiliary Regression'); + OutputFrm.RichEdit.Lines.Add(''); + BPG := 0.0; + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'BPGResid.'; + OS3MainFrm.DataGrid.Cells[col,0] := 'BPGResid.'; + NoVariables := NoVariables + 1; + // get predicted raw score + for i := 1 to NCases do + begin + Y := 0.0; + for j := 1 to NoIndepVars do + begin + col := IndepIndex[j-1]; + k := ColEntered[col-1]; + z := (StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i])) - + Means[col-1]) / StdDevs[col-1]; + Y := Y + (z * BetaWeights[j-1]); // predicted z score + end; + Y := Y * StdDevs[NEntered-1] + Means[NEntered-1]; // predicte raw + k := ColEntered[NEntered-1]; + Y := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i])) - Y; // residual + BPG := BPG + (Y * Y); // sum of squared residuals + // save squared value for each case + OS3MainFrm.DataGrid.Cells[NoVariables,i] := FloatToStr(Y * Y); +// OS3MainFrm.DataGrid.Cells[NoVariables,i] := Format('%8.3f',[Y * Y]); + end; + BPG := BPG / NCases; + for i := 1 to NCases do + begin + Y := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[NoVariables,i])) / BPG; + OS3MainFrm.DataGrid.Cells[NoVariables,i] := Format('%8.3f',[Y]); + end; + // Now, regress Hetero values on the independent variables + DepVarCol := NoVariables; + ColEntered[NEntered-1] := NoVariables; + IndRowLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[DepVarCol,0]; + IndColLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[DepVarCol,0]; + Correlations(NEntered,ColEntered,Corrs,Means,Variances, + StdDevs,errcode,NCases); + if CorrsChkBox.Checked = true then + begin + title := 'Product-Moment Correlations Matrix'; + MAT_PRINT(Corrs,NEntered,NEntered,title,IndRowLabels,IndColLabels,NCases); + end; + title := 'Means'; + if MeansChkBox.Checked = true then + DynVectorPrint(Means,NEntered,title,IndColLabels,NCases); + title := 'Variances'; + if VarChkBox.Checked = true then + DynVectorPrint(Variances,NEntered,title,IndColLabels,NCases); + title := 'Standard Deviations'; + if SDChkBox.Checked = true then + DynVectorPrint(StdDevs,NEntered,title,IndColLabels,NCases); + MReg2(NCases,NEntered,NoIndepVars,IndepIndex,corrs,IndepInverse, + IndRowLabels,R2,BetaWeights, + Means,Variances,errorcode,StdErrEst,constant,prout,true, false,false); + BPG := ( R2 * Variances[NEntered-1] * (Ncases-1) ) / 2; + chiprob := 1.0 - chisquaredprob(BPG,NEntered-1); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Breusch-Pagan-Godfrey Test of Heteroscedasticity'); + outline := format('Chi-Square = %8.3f with probability greater value = %8.3f',[BPG,chiprob]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + end; +} + if MatSaveChkBox.Checked = true then + begin + SaveDialog1.Filter := 'FreeStat matrix files (*.MAT)|*.MAT|All files (*.*)|*.*'; + SaveDialog1.FilterIndex := 1; + if SaveDialog1.Execute then + begin + filename := SaveDialog1.FileName; + MATSAVE(Corrs,NoVars,NoVars,Means,StdDevs,NCases,IndRowLabels,IndColLabels,filename); + end; + end; + OutputFrm.ShowModal; +CleanUp: + ColEntered := nil; + Candidate := nil; + BetaWeights := nil; + IndColLabels := nil; + IndRowLabels := nil; + IndepIndex := nil; + StdDevs := nil; + Variances := nil; + Means := nil; + IndepInverse := nil; + corrs := nil; + VarsInBlk := nil; + BlkVarCols := nil; +end; + +procedure TBlkMregFrm.DepInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + DepVar.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + DepOutBtn.Enabled := true; + DepInBtn.Enabled := false; +end; + +procedure TBlkMregFrm.DepOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(DepVar.Text); + DepVar.Text := ''; + DepInBtn.Enabled := true; +end; + +procedure TBlkMregFrm.InBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + BlockList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + OutBtn.Enabled := true; +end; + +procedure TBlkMregFrm.NextBlkBtnClick(Sender: TObject); +var + blkno, i, j, count : integer; + cellstring : string; +begin + {save columns of variables in the current block } + count := BlockList.Items.Count; + if count = 0 then + begin + VarsInBlk[NoBlocks-1] := 0; + exit; + end; + VarsInBlk[NoBlocks-1] := count; + for i := 0 to count-1 do + begin + for j := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[j,0]; + if cellstring = BlockList.Items.Strings[i] then + begin + BlkVarCols[NoBlocks-1,i] := j; + NoVars := NoVars + 1; + end; + end; + end; + blkno := StrToInt(BlockNoEdit.Text); + blkno := blkno + 1; + BlockNoEdit.Text := IntToStr(blkno); + NoBlocks := blkno; + BlockList.Clear; +end; + +procedure TBlkMregFrm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := BlockList.ItemIndex; + VarList.Items.Add(BlockList.Items.Strings[index]); + BlockList.Items.Delete(index); + InBtn.Enabled := true; + if BlockList.Items.Count = 0 then OutBtn.Enabled := false; +end; + +initialization + {$I blkmregunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.lfm b/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.lfm new file mode 100644 index 000000000..053c77b48 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.lfm @@ -0,0 +1,420 @@ +object CoxRegFrm: TCoxRegFrm + Left = 457 + Height = 401 + Top = 291 + Width = 432 + AutoSize = True + Caption = 'Cox Proportional Hazards Survival Regression' + ClientHeight = 401 + ClientWidth = 432 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 9 + Width = 89 + BorderSpacing.Left = 8 + BorderSpacing.Top = 9 + Caption = 'Avaialbe Variable' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = BlockList + AnchorSideTop.Control = Owner + Left = 238 + Height = 15 + Top = 8 + Width = 116 + BorderSpacing.Top = 8 + Caption = 'Independent Variables' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = DepVar + AnchorSideBottom.Control = DepVar + Left = 238 + Height = 15 + Top = 108 + Width = 114 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Survival Time Variable' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = StatusEdit + AnchorSideBottom.Control = StatusEdit + Left = 238 + Height = 15 + Top = 195 + Width = 120 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Survival Status Variable' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrCenter + Left = 195 + Height = 15 + Top = 296 + Width = 117 + BorderSpacing.Left = 16 + Caption = 'Maximum Interations:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 221 + Top = 26 + Width = 186 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 202 + Height = 28 + Top = 26 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 202 + Height = 28 + Top = 58 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object DepInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Label3 + Left = 202 + Height = 28 + Top = 108 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInBtnClick + Spacing = 0 + TabOrder = 4 + end + object DepOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepInBtn + AnchorSideTop.Side = asrBottom + Left = 202 + Height = 28 + Top = 140 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object StatusInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = StatusOutBtn + Left = 202 + Height = 28 + Top = 187 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = StatusInBtnClick + Spacing = 0 + TabOrder = 7 + end + object StatusOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 202 + Height = 28 + Top = 219 + Width = 28 + Anchors = [akLeft, akBottom] + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = StatusOutBtnClick + Spacing = 0 + TabOrder = 8 + end + object BlockList: TListBox + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Label3 + Left = 238 + Height = 67 + Top = 25 + Width = 186 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 16 + ItemHeight = 0 + TabOrder = 3 + end + object DepVar: TEdit + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 238 + Height = 23 + Top = 125 + Width = 186 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + TabOrder = 6 + Text = 'DepVar' + end + object StatusEdit: TEdit + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = StatusOutBtn + AnchorSideBottom.Side = asrBottom + Left = 238 + Height = 23 + Top = 212 + Width = 186 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 9 + Text = 'StatusEdit' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 97 + Top = 255 + Width = 171 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ClientHeight = 77 + ClientWidth = 167 + TabOrder = 10 + object DescChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 127 + Caption = 'Descriptive Statistics' + TabOrder = 0 + end + object ProbsChk: TCheckBox + Left = 12 + Height = 19 + Top = 29 + Width = 143 + Caption = 'Base Survival Functions' + TabOrder = 1 + end + object ItersChk: TCheckBox + Left = 12 + Height = 19 + Top = 52 + Width = 101 + Caption = 'Show Iterations' + TabOrder = 2 + end + end + object MaxItsEdit: TEdit + AnchorSideLeft.Control = Label5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label5 + AnchorSideTop.Side = asrCenter + Left = 320 + Height = 23 + Top = 292 + Width = 42 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 11 + Text = 'MaxItsEdit' + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 111 + Height = 25 + Top = 368 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 32 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 12 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 177 + Height = 25 + Top = 368 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 13 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 251 + Height = 25 + Top = 368 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 14 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 339 + Height = 25 + Top = 368 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 32 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 15 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 352 + Width = 432 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.pas b/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.pas new file mode 100644 index 000000000..33d2d9a9d --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/coxregunit.pas @@ -0,0 +1,602 @@ +unit CoxRegUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + Globals, MainUnit, OutputUnit; + + +type + + { TCoxRegFrm } + + TCoxRegFrm = class(TForm) + Bevel1: TBevel; + InBtn: TBitBtn; + OutBtn: TBitBtn; + DepInBtn: TBitBtn; + DepOutBtn: TBitBtn; + StatusInBtn: TBitBtn; + StatusOutBtn: TBitBtn; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + DescChk: TCheckBox; + MaxItsEdit: TEdit; + Label5: TLabel; + ProbsChk: TCheckBox; + ItersChk: TCheckBox; + DepVar: TEdit; + GroupBox1: TGroupBox; + StatusEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + BlockList: TListBox; + Label3: TLabel; + Label4: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure DepInBtnClick(Sender: TObject); + procedure DepOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure StatusInBtnClick(Sender: TObject); + procedure StatusOutBtnClick(Sender: TObject); + function ChiSq(x : double; n : integer) : double; + function Norm(z : double): double; + function ix(j, k, nCols : integer): integer; + + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + CoxRegFrm: TCoxRegFrm; + +implementation + +uses + Math; + +{ TCoxRegFrm } + +procedure TCoxRegFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + BlockList.Clear; + VarList.Clear; + for i := 1 to NoVariables do + begin + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + end; + InBtn.Enabled := true; + OutBtn.Enabled := false; + DepInBtn.Enabled := true; + DepOutBtn.Enabled := false; + ProbsChk.Checked := true; + DescChk.Checked := true; + DepVar.Text := ''; + StatusEdit.Text := ''; + StatusInBtn.Enabled := true; + StatusOutBtn.Enabled := false; + MaxItsEdit.Text := '20'; +end; + +procedure TCoxRegFrm.StatusInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + StatusEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + StatusOutBtn.Enabled := true; + StatusInBtn.Enabled := false; +end; + +procedure TCoxRegFrm.StatusOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(StatusEdit.Text); + StatusEdit.Text := ''; + StatusInBtn.Enabled := true; +end; + +procedure TCoxRegFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TCoxRegFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TCoxRegFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TCoxRegFrm.DepInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + DepVar.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + DepOutBtn.Enabled := true; + DepInBtn.Enabled := false; +end; + +procedure TCoxRegFrm.ComputeBtnClick(Sender: TObject); +Label CleanUp; +var + i, j, k : integer; + indx : integer; + cellstring : string; + outline : string; + nR : integer; // no. independent variables + ColNoSelected : IntDyneVec; + nC : integer; // no. cases + nP : integer; // survival time variable + nS : integer; // survival status variable + zX : double; + v : double; + Eps : double; + iBig : integer; + LLp, LL : double; + LLn : double; + s0 : double; + StatI : double; + Sf : double; + RowLabels, ColLabels : StrDyneVec; + CSq : double; // chi square statistic + prob : double; // probability of chi square + SurvT : DblDyneVec; + Stat : DblDyneVec; + Dupl : DblDyneVec; + Alpha : DblDyneVec; + a : DblDyneVec; + b : DblDyneVec; + s1 : DblDyneVec; + s2 : DblDyneVec; + s : DblDyneVec; + Av : DblDyneVec; + SD : DblDyneVec; + SE : DblDyneVec; + x : DblDyneVec; // data matrix for independent variables + Lo95 : double; + Hi95 : double; + d : double; + iters : integer; + +begin + OutputFrm.RichEdit.Clear; +// OutputFrm.RichEdit.ParaGraph.Alignment := taLeftJustify; + OutputFrm.RichEdit.Lines.Add('Cox Proportional Hazards Survival Regression Adapted from John C. Pezzullo'); + OutputFrm.RichEdit.Lines.Add('Java program at http://members.aol.com/johnp71/prophaz.html'); + + { get independent item columns } + nR := BlockList.Items.Count; + nC := NoCases; + SetLength(ColNoSelected,nR + 2); + SetLength(RowLabels,nR + 2); + SetLength(ColLabels,nR + 2); + if nR < 1 then + begin + ShowMessage('ERROR! No independent variables selected.'); + goto CleanUp; + end; + + for i := 1 to nR do + begin + cellstring := BlockList.Items.Strings[i-1]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[i-1] := j; + RowLabels[i-1] := cellstring; + ColLabels[i-1] := cellstring; + end; + end; + end; + + { get survival time variable column and survival status var. column } + if DepVar.Text = '' then + begin + ShowMessage('Error! No Survival time variable selected.'); + goto CleanUp; + end; + if StatusEdit.Text = '' then + begin + ShowMessage('Error! No Survival Status variable selected.'); + goto Cleanup; + end; + nP := nR + 1; + nS := nP + 1; + for j := 1 to NoVariables do + begin + if DepVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[nP-1] := j; + RowLabels[nP-1] := OS3MainFrm.DataGrid.Cells[j,0]; + ColLabels[nP-1] := RowLabels[nP-1]; + end; + if StatusEdit.Text = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[nS-1] := j; + RowLabels[nS-1] := OS3MainFrm.DataGrid.Cells[j,0]; + ColLabels[nS-1] := RowLabels[nS-1]; + end; + end; + + SetLength(SurvT,nC + 1); + SetLength(Stat,nC + 1); + SetLength(Dupl,nC + 1); + SetLength(Alpha,nC + 1); + SetLength(x,(nC + 1) * (nR + 1)); + SetLength(b,nC + 1); + SetLength(a,(nR + 1) * (nR + 1)); + SetLength(s1,nR + 1); + SetLength(s2,(nR + 1) * (nR + 1)); + SetLength(s,nR + 1); + SetLength(Av,nR + 1); + SetLength(SD,nR + 1); + SetLength(SE,nR + 1); + + // get data + for i := 0 to nC - 1 do + begin + indx := ix(i,0,nR+1); + X[indx] := 1; + for j := 0 to nR-1 do + begin + indx := ColNoSelected[j]; + zX := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1])); + indx := ix(i,j,nR); + x[indx] := zX; + Av[j] := Av[j] + zX; + SD[j] := SD[j] + (zX * zX); + end; + // get survival time + indx := ColNoSelected[nP-1]; + zX := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1])); + SurvT[i] := zX; + // get survival status + indx := ColNoSelected[nS-1]; + zX := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1])); + Stat[i] := zX; + end; // next case i + + // print descriptive statistics + OutputFrm.RichEdit.Lines.Add(''); + if DescChk.Checked then + begin + OutputFrm.RichEdit.Lines.Add('Descriptive Statistics'); + OutputFrm.RichEdit.Lines.Add('Variable Label Average Std.Dev.'); + end; + for j := 0 to nR-1 do + begin + Av[j] := Av[j] / nC; + SD[j] := SD[j] / nC; + SD[j] := sqrt( abs(SD[j] - Av[j] * Av[j])); + if DescChk.Checked then + begin + outline := format(' %3d %15s %10.4f %10.4f',[j+1,RowLabels[j],Av[j],SD[j]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + OutputFrm.RichEdit.Lines.Add(''); + + d := 0.0; + Eps := 1.0 / 1024.0; + for i := 0 to nC-2 do + begin + iBig := i; + for j := i+1 to nC-1 do + begin + if (SurvT[j] - Eps * Stat[j]) > (SurvT[iBig]-Eps * Stat[iBig]) then + iBig := j; + end; + if iBig <> i then + begin + v := SurvT[i]; + SurvT[i] := SurvT[iBig]; + SurvT[iBig] := v; + v := Stat[i]; + Stat[i] := Stat[iBig]; + Stat[iBig] := v; + for j := 0 to nR-1 do + begin + v := x[ix(i,j,nR)]; + x[ix(i,j,nR)] := x[ix(iBig,j,nR)]; + x[ix(iBig,j,nR)] := v; + end; + end; + end; + + if Stat[0] > 0 then Stat[0] := Stat[0] + 2; + for i := 1 to nC-1 do + begin + if (Stat[i] > 0) and ((Stat[i-1] = 0) or (SurvT[i-1] <> SurvT[i])) then + Stat[i] := Stat[i] + 2; + end; + if Stat[nC-1] > 0 then Stat[nC-1] := Stat[nC-1] + 4; + for i := nC-2 downto 0 do + begin + if (Stat[i] > 0) and ((Stat[i+1] = 0) or (SurvT[i+1] <> Survt[i])) then + Stat[i] := Stat[i] + 4; + end; + for i := 0 to nC-1 do + begin + for j := 0 to nR-1 do + begin + x[ix(i,j,nR)] := (x[ix(i,j,nR)] - Av[j]) / SD[j]; + end; + end; + if ItersChk.Checked then OutputFrm.RichEdit.Lines.Add('Iteration History...'); + for j := 0 to nR-1 do b[j] := 0; + LLp := 2.0e30; + LL := 1.0e30; + + // start iterations + iters := 0; + while (Abs(LLp-LL) > 0.0001) do + begin + iters := iters + 1; + if iters > StrToInt(MaxItsEdit.Text) then break; + LLp := LL; + LL := 0.0; + s0 := 0.0; + for j := 0 to nR-1 do + begin + s1[j] := 0.0; + a[ix(j,nR,nR+1)] := 0.0; + for k := 0 to nR-1 do + begin + s2[ix(j,k,nR)] := 0.0; + a[ix(j,k,nR+1)] := 0.0; + end; + end; + for i := 0 to nC-1 do + begin + Alpha[i] := 1.0; + v := 0.0; + for j := 0 to nR-1 do v := v + b[j] * x[ix(i,j,nR)]; + v := exp(v); + s0 := s0 + v; + for j := 0 to nR-1 do + begin + s1[j] := s1[j] + x[ix(i,j,nR)] * v; + for k := 0 to nR-1 do + s2[ix(j,k,nR)] := s2[ix(j,k,nR)] + x[ix(i,j,nR)] * x[ix(i,k,nR)] * v; + end; + StatI := Stat[i]; + if (StatI = 2) or (StatI = 3) or (StatI = 6) or (StatI = 7) then + begin + d := 0.0; + for j := 0 to nR-1 do s[j] := 0.0; + end; + if (StatI = 1) or (StatI = 3) or (StatI = 5) or (StatI = 7) then + begin + d := d + 1; + for j := 0 to nR-1 do s[j] := s[j] + x[ix(i,j,nR)]; + end; + if (StatI = 4) or (StatI = 5) or (StatI = 6) or (StatI = 7) then + begin + for j := 0 to nR-1 do + begin + LL := LL + s[j] * b[j]; + a[ix(j,nR,nR+1)] := a[ix(j,nR,nR+1)] + s[j] - d * s1[j] / s0; + for k := 0 to nR-1 do + begin + a[ix(j,k,nR+1)] := a[ix(j,k,nR+1)] + d * (s2[ix(j,k,nR)] / s0 - + s1[j] * s1[k] / (s0 * s0)); + end; + end; + LL := LL - d * Ln(s0); + if d = 1 then Alpha[i] := Power((1.0 - v / s0),(1.0 / v)) + else Alpha[i] := exp(-d / s0); + end; + end; + LL := -2.0 * LL; + outline := format('-2 Log Likelihood = %10.4f',[LL]); + if iters = 1 then + begin + LLn := LL; + if ItersChk.Checked then + outline := outline + ' (Null Model)'; + end; + if ItersChk.Checked then + OutputFrm.RichEdit.Lines.Add(outline); + for i := 0 to nR-1 do + begin + v := a[ix(i,i,nR+1)]; + a[ix(i,i,nR+1)] := 1.0; + for k := 0 to nR do + a[ix(i,k,nR+1)] := a[ix(i,k,nR+1)] / v; + for j := 0 to nR-1 do + begin + if i <> j then + begin + v := a[ix(j,i,nR+1)]; + a[ix(j,i,nR+1)] := 0.0; + for k := 0 to nR do + a[ix(j,k,nR+1)] := a[ix(j,k,nR+1)] - v * a[ix(i,k,nR+1)]; + end; + end; + end; + for j := 0 to nR-1 do b[j] := b[j] + a[ix(j,nR,nR+1)]; + end; + + OutputFrm.RichEdit.Lines.Add('Converged'); + Csq := LLn - LL; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Overall Model Fit...'); + if Csq > 0.0 then prob := ChiSq(Csq,nR) else prob := 1.0; + outline := format('Chi Square = %8.4f with d.f. %d and probability = %8.4f',[Csq,nR,prob]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Coefficients, Std Errs, Signif, and Confidence Intervals'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Var Coeff. StdErr p Lo95% Hi95%'); + for j := 0 to nR-1 do + begin + b[j] := b[j] / SD[j]; + SE[j] := sqrt(a[ix(j,j,nR+1)]) / SD[j]; + prob := Norm(Abs(b[j] / SE[j])); + Lo95 := b[j] - 1.96 * SE[j]; + Hi95 := b[j] + 1.96 * SE[j]; + outline := format('%10s %10.4f %10.4f %8.4f %8.4f %8.4f', + [RowLabels[j],b[j],SE[j],prob,Lo95,Hi95]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Risk Ratios and Confidence Intervals'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Variable Risk Ratio Lo95% Hi95%'); + for j := 0 to nR-1 do + begin + outline := format('%10s %10.4f %10.4f %10.4f', + [RowLabels[j],exp(b[j]),exp(b[j]-1.96*SE[j]),exp(b[j]+1.96*SE[j])]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + if ProbsChk.Checked then + OutputFrm.RichEdit.Lines.Add('Baseline Survivor Function (at predictor means)...'); + SF := 1.0; + for i := nC-1 downto 0 do + begin + Sf := Sf * Alpha[i]; + if Alpha[i] < 1.0 then + begin + if ProbsChk.Checked then + begin + outline := format('%10.4f %10.4f',[SurvT[i],Sf]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + end; + OutputFrm.ShowModal; + +cleanup: + SurvT := nil; + Stat := nil; + Dupl := nil; + Alpha := nil; + x := nil; + b := nil; + a := nil; + s1 := nil; + s2 := nil; + s := nil; + Av := nil; + SD := nil; + SE := nil; + RowLabels := nil; + ColLabels := nil; + ColNoSelected := nil; +end; + +procedure TCoxRegFrm.DepOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(DepVar.Text); + DepVar.Text := ''; + DepInBtn.Enabled := true; +end; + +procedure TCoxRegFrm.InBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + BlockList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + OutBtn.Enabled := true; +end; + +procedure TCoxRegFrm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := BlockList.ItemIndex; + VarList.Items.Add(BlockList.Items.Strings[index]); + BlockList.Items.Delete(index); + InBtn.Enabled := true; + if BlockList.Items.Count = 0 then OutBtn.Enabled := false; +end; + +function TCoxRegFrm.ChiSq(x : double; n : integer) : double; +var + p, t, a : double; + k : integer; + +begin + p := exp(-0.5 * x); + if n mod 2 = 1 then p := p * sqrt(2 * x / Pi); + k := n; + while K >= 2 do + begin + p := p * x / k; + k := k - 2; + end; + t := p; + a := n; + while t > 0.000001 * p do + begin + a := a + 2; + t := t * x / a; + p := p + t; + end; + ChiSq := (1 - p); +end; +//------------------------------------------------------------------- + +function TCoxRegFrm.Norm(z : double): double; +begin + Norm := ChiSq(z * z, 1); +end; +//------------------------------------------------------------------- + +function TCoxRegFrm.ix(j, k, nCols : integer): integer; +begin + ix := j * nCols + k; +end; + +initialization + {$I coxregunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/linprounit.lfm b/applications/lazstats/source/forms/analysis/multiple_regression/linprounit.lfm new file mode 100644 index 000000000..664904e6b --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/linprounit.lfm @@ -0,0 +1,623 @@ +object LinProFrm: TLinProFrm + Left = 445 + Height = 507 + Top = 263 + Width = 811 + Caption = 'Linear Programming Using Min/Max Algorithm' + ClientHeight = 507 + ClientWidth = 811 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = FileNameEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 12 + Width = 21 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'File:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ObjectiveGrid + AnchorSideTop.Control = FileNameEdit + AnchorSideTop.Side = asrBottom + Left = 167 + Height = 15 + Top = 39 + Width = 50 + BorderSpacing.Top = 8 + Caption = 'Objective' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Panel4 + Left = 97 + Height = 15 + Top = 67 + Width = 60 + BorderSpacing.Right = 4 + Caption = 'Constraints' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NoVarsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NoVarsEdit + Left = 654 + Height = 15 + Top = 12 + Width = 68 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'No. Variables' + ParentColor = False + end + object Label6: TLabel + Left = 10 + Height = 1 + Top = 91 + Width = 1 + ParentColor = False + end + object Label11: TLabel + AnchorSideLeft.Control = MinMaxGrp + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ResultsEdit + AnchorSideTop.Side = asrCenter + Left = 208 + Height = 15 + Top = 435 + Width = 83 + BorderSpacing.Left = 16 + Caption = 'General Results:' + ParentColor = False + end + object FileNameEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Label4 + Left = 37 + Height = 23 + Top = 8 + Width = 601 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 + TabOrder = 0 + Text = 'FileNameEdit' + end + object ObjectiveGrid: TStringGrid + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 167 + Height = 26 + Top = 56 + Width = 636 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 70 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ColCount = 1 + RowCount = 1 + TabOrder = 1 + end + object NoVarsEdit: TEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 730 + Height = 23 + Top = 8 + Width = 73 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + OnExit = NoVarsEditExit + OnKeyPress = NoVarsEditKeyPress + TabOrder = 2 + Text = 'NoVarsEdit' + end + object ResultsEdit: TEdit + AnchorSideLeft.Control = Label11 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 299 + Height = 23 + Top = 431 + Width = 504 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 4 + TabOrder = 4 + Text = 'ResultsEdit' + end + object LoadBtn: TButton + AnchorSideRight.Control = SaveBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 358 + Height = 25 + Top = 474 + Width = 73 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Load File' + OnClick = LoadBtnClick + TabOrder = 5 + end + object SaveBtn: TButton + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 443 + Height = 25 + Top = 474 + Width = 71 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Save File' + OnClick = SaveBtnClick + TabOrder = 6 + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 526 + Height = 25 + Top = 474 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 7 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 592 + Height = 25 + Top = 474 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 8 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ExitBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 666 + Height = 25 + Top = 474 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 9 + end + object ExitBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 754 + Height = 25 + Top = 474 + Width = 45 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Exit' + ModalResult = 1 + OnClick = ExitBtnClick + TabOrder = 10 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ResetBtn + Left = 0 + Height = 8 + Top = 458 + Width = 811 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel4: TPanel + AnchorSideLeft.Control = Panel5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ObjectiveGrid + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ResultsEdit + Left = 97 + Height = 333 + Top = 82 + Width = 706 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ChildSizing.VerticalSpacing = 4 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsHomogenousChildResize + ChildSizing.ShrinkVertical = crsHomogenousSpaceResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 333 + ClientWidth = 706 + TabOrder = 11 + object Panel1: TPanel + Left = 0 + Height = 109 + Top = 0 + Width = 706 + BevelOuter = bvNone + ClientHeight = 109 + ClientWidth = 706 + TabOrder = 0 + object MaxGrid: TStringGrid + AnchorSideLeft.Control = MaxConstraintsGrid + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 70 + Height = 101 + Top = 8 + Width = 636 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 4 + ColCount = 1 + RowCount = 1 + TabOrder = 0 + end + object MaxConstraintsGrid: TStringGrid + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = MaxGrid + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 101 + Top = 8 + Width = 66 + Anchors = [akTop, akLeft, akBottom] + ColCount = 1 + RowCount = 1 + ScrollBars = ssNone + TabOrder = 1 + end + end + object Panel2: TPanel + Left = 0 + Height = 109 + Top = 113 + Width = 706 + BevelOuter = bvNone + ClientHeight = 109 + ClientWidth = 706 + TabOrder = 1 + object MinGrid: TStringGrid + AnchorSideLeft.Control = MinConstraintsGrid + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 72 + Height = 109 + Top = 0 + Width = 634 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 4 + ColCount = 1 + RowCount = 1 + TabOrder = 0 + end + object MinConstraintsGrid: TStringGrid + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Panel2 + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 109 + Top = 0 + Width = 68 + Anchors = [akTop, akLeft, akBottom] + ColCount = 1 + RowCount = 1 + ScrollBars = ssNone + TabOrder = 1 + end + end + object Panel3: TPanel + Left = 0 + Height = 107 + Top = 226 + Width = 706 + BevelOuter = bvNone + ClientHeight = 107 + ClientWidth = 706 + TabOrder = 2 + object EqualGrid: TStringGrid + AnchorSideLeft.Control = EqualConstraintsGrid + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel3 + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel3 + AnchorSideBottom.Side = asrBottom + Left = 70 + Height = 107 + Top = 0 + Width = 636 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 4 + ColCount = 1 + RowCount = 1 + TabOrder = 0 + end + object EqualConstraintsGrid: TStringGrid + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = Panel3 + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel3 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 107 + Top = 0 + Width = 66 + Anchors = [akTop, akLeft, akBottom] + ColCount = 1 + RowCount = 1 + ScrollBars = ssNone + TabOrder = 1 + end + end + end + object Panel5: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel4 + AnchorSideBottom.Control = Panel4 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 333 + Top = 82 + Width = 81 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Left = 8 + BevelOuter = bvNone + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 333 + ClientWidth = 81 + TabOrder = 12 + object Panel6: TPanel + Left = 0 + Height = 111 + Top = 0 + Width = 81 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 111 + ClientWidth = 81 + TabOrder = 0 + object Label5: TLabel + AnchorSideLeft.Control = Panel6 + AnchorSideTop.Control = Panel6 + AnchorSideRight.Control = Panel6 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 30 + Top = 0 + Width = 81 + Alignment = taCenter + Anchors = [akTop, akLeft, akRight] + Caption = 'No.Max. (<)'#13#10'constraints' + ParentColor = False + end + object NoMaxEdit: TEdit + AnchorSideLeft.Control = Panel6 + AnchorSideTop.Control = Label5 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel6 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 23 + Top = 32 + Width = 81 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + OnExit = NoMaxEditExit + OnKeyPress = NoMaxEditKeyPress + TabOrder = 0 + Text = 'NoMaxEdit' + end + end + object Panel7: TPanel + Left = 0 + Height = 111 + Top = 111 + Width = 81 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 111 + ClientWidth = 81 + TabOrder = 1 + object Label7: TLabel + AnchorSideLeft.Control = Panel7 + AnchorSideTop.Control = Panel7 + AnchorSideRight.Control = Panel7 + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 30 + Top = 0 + Width = 73 + Alignment = taCenter + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + Caption = 'No. Min. (>)'#13#10'constraints' + ParentColor = False + end + object NoMinEdit: TEdit + AnchorSideLeft.Control = Panel7 + AnchorSideTop.Control = Label7 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel7 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 23 + Top = 32 + Width = 81 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + OnExit = NoMinEditExit + OnKeyPress = NoMinEditKeyPress + TabOrder = 0 + Text = 'NoMinEdit' + end + end + object Panel8: TPanel + Left = 0 + Height = 111 + Top = 222 + Width = 81 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 111 + ClientWidth = 81 + TabOrder = 2 + object Label9: TLabel + AnchorSideLeft.Control = Panel8 + AnchorSideTop.Control = Panel8 + AnchorSideRight.Control = Panel8 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 30 + Top = 0 + Width = 81 + Alignment = taCenter + Anchors = [akTop, akLeft, akRight] + Caption = 'No. Equal (=)'#13#10'constraints' + ParentColor = False + end + object NoEqualEdit: TEdit + AnchorSideLeft.Control = Panel8 + AnchorSideTop.Control = Label9 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel8 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 23 + Top = 32 + Width = 81 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + OnExit = NoEqualEditExit + OnKeyPress = NoEqualEditKeyPress + TabOrder = 0 + Text = 'NoEqualEdit' + end + end + end + object MinMaxGrp: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel4 + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 49 + Top = 415 + Width = 184 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Min/Max' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 5 + ChildSizing.HorizontalSpacing = 16 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 29 + ClientWidth = 180 + Columns = 2 + Items.Strings = ( + 'Maximize' + 'Minimize' + ) + TabOrder = 3 + end + object OpenDialog1: TOpenDialog + left = 696 + top = 136 + end + object SaveDialog1: TSaveDialog + left = 600 + top = 120 + end +end diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/linprounit.pas b/applications/lazstats/source/forms/analysis/multiple_regression/linprounit.pas new file mode 100644 index 000000000..ce5a169d4 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/linprounit.pas @@ -0,0 +1,736 @@ +unit LinProUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Grids, ExtCtrls, + OutputUnit, Globals; + +type + + { TLinProFrm } + + TLinProFrm = class(TForm) + Bevel1: TBevel; + ExitBtn: TButton; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + Panel4: TPanel; + Panel5: TPanel; + Panel6: TPanel; + Panel7: TPanel; + Panel8: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + LoadBtn: TButton; + SaveBtn: TButton; + OpenDialog1: TOpenDialog; + ResultsEdit: TEdit; + Label11: TLabel; + NoEqualEdit: TEdit; + Label9: TLabel; + NoMinEdit: TEdit; + Label7: TLabel; + NoMaxEdit: TEdit; + Label5: TLabel; + Label6: TLabel; + NoVarsEdit: TEdit; + FileNameEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + ObjectiveGrid: TStringGrid; + MaxGrid: TStringGrid; + MinGrid: TStringGrid; + EqualGrid: TStringGrid; + MaxConstraintsGrid: TStringGrid; + MinConstraintsGrid: TStringGrid; + EqualConstraintsGrid: TStringGrid; + MinMaxGrp: TRadioGroup; + SaveDialog1: TSaveDialog; + procedure CancelBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure ExitBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure LoadBtnClick(Sender: TObject); + procedure NoEqualEditExit(Sender: TObject); + procedure NoEqualEditKeyPress(Sender: TObject; var Key: char); + procedure NoMaxEditExit(Sender: TObject); + procedure NoMaxEditKeyPress(Sender: TObject; var Key: char); + procedure NoMinEditExit(Sender: TObject); + procedure NoMinEditKeyPress(Sender: TObject; var Key: char); + procedure NoVarsEditExit(Sender: TObject); + procedure NoVarsEditKeyPress(Sender: TObject; var Key: char); + procedure ResetBtnClick(Sender: TObject); + procedure SaveBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + NoVars, NoMax, NoMin, NoEql, MinMax, NoCoefs : integer; + Objective : DblDyneVec; + MaxConstraints : DblDyneVec; + MinConstraints : DblDyneVec; + EqlConstraints : DblDyneVec; + Coefficients : DblDyneMat; + + PROCEDURE simplx(VAR a: DblDyneMat; m,n,mp,np,m1,m2,m3: integer; + VAR icase: integer; VAR izrov: IntDyneVec; + VAR iposv: IntDyneVec); + PROCEDURE simp1(VAR a: DblDyneMat; mp,np,mm: integer; + ll: IntDyneVec; nll,iabf: integer; + VAR kp: integer; VAR bmax: double); + PROCEDURE simp2(VAR a: DblDyneMat; m,n,mp,np: integer; + l2: IntDyneVec; nl2: integer; VAR ip: integer; + kp: integer; VAR q1: double); + PROCEDURE simp3(VAR a: DblDyneMat; mp,np,i1,k1,ip,kp: integer); + procedure LoadArrayData(Sender: TObject); + + public + { public declarations } + end; + +var + LinProFrm: TLinProFrm; + +implementation + +uses + Math; + +{ TLinProFrm } + +procedure TLinProFrm.ResetBtnClick(Sender: TObject); +begin + NoVarsEdit.Text := '0'; + NoMaxEdit.Text := ''; + NoMinEdit.Text := ''; + NoEqualEdit.Text := ''; + MinMaxGrp.ItemIndex := 0; + FileNameEdit.Text := ''; + MaxConstraintsGrid.RowCount := 1; + MaxConstraintsGrid.ColCount := 1; + MaxConstraintsGrid.Cells[0,0] := ''; + MinConstraintsGrid.RowCount := 1; + MinConstraintsGrid.ColCount := 1; + MinConstraintsGrid.Cells[0,0] := ''; + EqualConstraintsGrid.RowCount := 1; + EqualConstraintsGrid.ColCount := 1; + EqualConstraintsGrid.Cells[0,0] := ''; + ObjectiveGrid.RowCount := 1; + ObjectiveGrid.ColCount := 1; + ObjectiveGrid.Cells[0,0] := ''; + MaxGrid.RowCount := 1; + MaxGrid.ColCount := 1; + MaxGrid.Cells[0,0] := ''; + MinGrid.RowCount := 1; + MinGrid.ColCount := 1; + MinGrid.Cells[0,0] := ''; + EqualGrid.RowCount := 1; + EqualGrid.ColCount := 1; + EqualGrid.Cells[0,0] := ''; + ResultsEdit.Text := ''; +end; + +procedure TLinProFrm.SaveBtnClick(Sender: TObject); +var + F : TextFile; + i, j : integer; + FName : string; +begin + LoadArrayData(Self); + SaveDialog1.DefaultExt := 'LPR'; + SaveDialog1.Filter := 'Linear Programming File (*.LPR)|*.LPR|All Files (*.*)|*.*'; + SaveDialog1.FilterIndex := 1; + if SaveDialog1.Execute then + begin + FName := SaveDialog1.FileName; + AssignFile(F,FName); + Rewrite(F); + writeln(F,NoVars); + writeln(F,NoMax); + writeln(F,NoMin); + writeln(F,NoEql); + writeln(F,MinMax); + NoCoefs := NoMax + NoMin + NoEql; + for i := 1 to NoVars do writeln(F,Objective[i]); + for i := 1 to NoMax do writeln(F,MaxConstraints[i]); + for i := 1 to NoMin do writeln(F,MinConstraints[i]); + for i := 1 to NoEql do writeln(F,EqlConstraints[i]); + for i := 1 to NoCoefs do + for j := 1 to NoVars do writeln(F,Coefficients[i,j]); + CloseFile(F); + end; +end; + +procedure TLinProFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([LoadBtn.Width, SaveBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ExitBtn.Width]); + LoadBtn.Constraints.MinWidth := w; + SaveBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ExitBtn.Constraints.MinWidth := w; + + FAutoSized := true; +end; + +procedure TLinProFrm.FormCreate(Sender: TObject); +begin + if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TLinProFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TLinProFrm.LoadBtnClick(Sender: TObject); +var + i, j : integer; + FName : string; + F : TextFile; +begin + // load values + OpenDialog1.DefaultExt := 'LPR'; + OpenDialog1.Filter := 'Linear Programming File (*.LPR)|*.LPR|All Files (*.*)|*.*'; + OpenDialog1.FilterIndex := 1; + if OpenDialog1.Execute then + begin + FName := OpenDialog1.FileName; + AssignFile(F,FName); + FileMode := 0; {Set file access to read only } + Reset(F); + readln(F,NoVars); + readln(F,NoMax); + readln(F,NoMin); + readln(F,NoEql); + readln(F,MinMax); + NoCoefs := NoMax + NoMin + NoEql; + + // allocate space + SetLength(Objective,NoVars + 1); + SetLength(MaxConstraints,NoMax + 1); + SetLength(MinConstraints,NoMin + 1); + SetLength(EqlConstraints,NoEql+1); + SetLength(Coefficients,NoCoefs+1,NoVars+1); + + for i := 1 to NoVars do readln(F,Objective[i]); + for i := 1 to NoMax do readln(F,MaxConstraints[i]); + for i := 1 to NoMin do readln(F,MinConstraints[i]); + for i := 1 to NoEql do readln(F,EqlConstraints[i]); + for i := 1 to NoCoefs do + for j := 1 to NoVars do readln(F,Coefficients[i,j]); + CloseFile(F); + end; + // GetFileData(FName); + FileNameEdit.Text := FName; + NoVarsEdit.Text := IntToStr(NoVars); + NoMaxEdit.Text := IntToStr(NoMax); + NoMinEdit.Text := IntToStr(NoMin); + NoEqualEdit.Text := IntToStr(NoEql); + MinMaxGrp.ItemIndex := MinMax; + MaxConstraintsGrid.RowCount := NoMax; + MinConstraintsGrid.RowCount := NoMin; + EqualConstraintsGrid.RowCount := NoEql; + ObjectiveGrid.ColCount := NoVars; + MaxGrid.RowCount := NoMax; + MaxGrid.ColCount := NoVars; + MinGrid.RowCount := NoMin; + MinGrid.ColCount := NoVars; + EqualGrid.RowCount := NoEql; + EqualGrid.ColCount := NoVars; + + // Place objectives in grid + for i := 1 to NoVars do + ObjectiveGrid.Cells[i-1,0] := FloatToStr(Objective[i]); + + // Place Maximum constraints in grid + for i := 1 to NoMax do + begin + MaxConstraintsGrid.Cells[0,i-1] := FloatToStr(MaxConstraints[i]); + for j := 1 to NoVars do MaxGrid.Cells[j-1,i-1] := FloatToStr(Coefficients[i,j]); + end; + + // Place Minimum constraints in grid + for i := 1 to NoMin do + begin + MinConstraintsGrid.Cells[0,i-1] := FloatToStr(MinConstraints[i]); + for j := 1 to NoVars do + MinGrid.Cells[j-1,i-1] := FloatToStr(Coefficients[NoMax+i,j]); + END; + + // Place Equal constraints in grid + for i := 1 to NoEql do + begin + EqualConstraintsGrid.Cells[0,i-1] := FloatToStr(EqlConstraints[i]); + for j := 1 to NoVars do + EqualGrid.Cells[j-1,i-1] := FloatToStr(Coefficients[NoMax+NoMin+i,j]); + end; + ComputeBtn.SetFocus; +end; + +procedure TLinProFrm.CancelBtnClick(Sender: TObject); +begin + Coefficients := nil; + EqlConstraints := nil; + MinConstraints := nil; + MaxConstraints := nil; + Objective := nil; + Close; +end; + +procedure TLinProFrm.ComputeBtnClick(Sender: TObject); +var + m1, m2, m3, m, mp, n, np, nm1m2 : integer; + i,icase,j : integer; + izrov : IntDyneVec; + iposv : IntDyneVec; + a : DblDyneMat; + txt : StrDyneVec; + outline : string; + +begin + n := NoVars; + m1 := NoMax; + m2 := NoMin; + m3 := NoEql; + m := m1 + m2 + m3; + np := n+1; (* np >= n+1 *) + mp := m + 2; (* mp >= m+2 *) + nm1m2 := n + m1 + m2; (* nm1m2=n+m1+m2 *) + SetLength(izrov,n+1); + SetLength(iposv,m+1); + SetLength(a,mp+1,np+1); + SetLength(txt,nm1m2+1); + + // Initialize labels + for i := 1 to NoVars do txt[i] := 'X' + IntToStr(i); + for i := NoVars + 1 to nm1m2 do txt[i] := 'Y' + IntToStr(i-NoVars); + + // Fill array data from grid + LoadArrayData(Self); + for i := 1 to NoVars do a[1,i+1] := Objective[i]; + a[1,1] := 0.0; + for i := 1 to NoMax do + begin + a[i+1,1] := MaxConstraints[i]; + for j := 1 to NoVars do a[i+1,j+1] := coefficients[i,j]; + end; + for i := 1 to NoMin do + begin + a[i+1+NoMax,1] := MinConstraints[i]; + for j := 1 to NoVars do a[i+1+NoMax,j+1] := Coefficients[i+NoMax,j]; + end; + for i := 1 to NoEql do + begin + a[i+1+NoMax+NoMin,1] := EqlConstraints[i]; + for j := 1 to NoVars do + a[i+1+NoMax+NoMin,j+1] := coefficients[i+NoMax+NoMin,j]; + end; + if MinMaxGrp.ItemIndex = 1 then + begin + MinMax := 1; + for i := 1 to NoVars do a[1,i+1] := -1.0 * a[1,i+1]; + end; + + // Do analysis + simplx(a,m,n,mp,np,m1,m2,m3,icase,izrov,iposv); + if MinMax = 1 then a[1,1] := -a[1,1]; + + // Report results + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Linear Programming Results'); + OutputFrm.RichEdit.Lines.Add(''); + + + outline := ''; + IF (icase = 1) THEN + BEGIN + ResultsEdit.Text := 'Unbounded objective function.'; + OutputFrm.RichEdit.Lines.Add('Unbounded object function.') + END + ELSE IF (icase = -1) THEN + BEGIN + ResultsEdit.Text := 'No solutions satisfy constraints given.'; + OutputFrm.RichEdit.Lines.Add('No solutions satisfy constraints given') + END ELSE + BEGIN + ResultsEdit.Text := 'Solution found.'; + outline := ' '; + FOR i := 1 to n DO + BEGIN + IF (izrov[i] <= nm1m2) THEN + BEGIN + outline := outline + format('%10s',[txt[izrov[i]]]); + END; + END; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := ''; + FOR i := 1 to m+1 DO + BEGIN + IF (i > 1) THEN + BEGIN + outline := outline + format('%3s',[txt[iposv[i-1]]]); + END + ELSE BEGIN + outline := outline + ' z'; + END; + FOR j := 1 to (n+1) DO + BEGIN + IF (j=1) THEN + outline := outline + format('%10.4f',[a[i,j]]); + IF (j>1) THEN + BEGIN + IF (izrov[j-1] <= nm1m2) THEN + outline := outline + format('%10.4f',[a[i,j]]); + END; + END; + OutputFrm.RichEdit.Lines.Add(outline); + outline := ''; + END; + END; + OutputFrm.ShowModal; + +// ShowOutPut(m1, m2, m3, m, n, icase, a, iposv, izrov, Self); + + // cleanup + txt := nil; + a := nil; + iposv := nil; + izrov := nil; +end; + +procedure TLinProFrm.ExitBtnClick(Sender: TObject); +begin + Coefficients := nil; + EqlConstraints := nil; + MinConstraints := nil; + MaxConstraints := nil; + Objective := nil; + Close; +end; + +procedure TLinProFrm.NoEqualEditExit(Sender: TObject); +VAR value : integer; +begin + value := StrToInt(NoEqualEdit.Text); + if value = 0 then exit; + EqualConstraintsGrid.RowCount := value; + EqualGrid.RowCount := value; + NoEql := value; + SetLength(EqlConstraints,value + 1); + NoCoefs := NoMax + NoMin + NoEql; + SetLength(Coefficients,NoCoefs+1,NoVars+1); +end; + +procedure TLinProFrm.NoEqualEditKeyPress(Sender: TObject; var Key: char); +begin + if ord(Key) = 13 then ObjectiveGrid.SetFocus; +end; + +procedure TLinProFrm.NoMaxEditExit(Sender: TObject); +VAR value : integer; +begin + value := StrToInt(NoMaxEdit.Text); + if value = 0 then exit; + MaxConstraintsGrid.RowCount := value; + MaxGrid.RowCount := value; + NoMax := value; + SetLength(MaxConstraints,NoMax + 1); +end; + +procedure TLinProFrm.NoMaxEditKeyPress(Sender: TObject; var Key: char); +begin + if ord(Key) = 13 then NoMinEdit.SetFocus; +end; + +procedure TLinProFrm.NoMinEditExit(Sender: TObject); +VAR value : integer; +begin + value := StrToInt(NoMinEdit.Text); + if value = 0 then exit; + MinConstraintsGrid.RowCount := value; + MinGrid.RowCount := value; + NoMin := value; + SetLength(MinConstraints,NoMin + 1); +end; + +procedure TLinProFrm.NoMinEditKeyPress(Sender: TObject; var Key: char); +begin + if ord(Key) = 13 then NoEqualEdit.SetFocus; +end; + +procedure TLinProFrm.NoVarsEditExit(Sender: TObject); +var value : integer; +begin + value := StrToInt(NoVarsEdit.Text); + if value = 0 then exit; + ObjectiveGrid.ColCount := value; + MaxGrid.ColCount := value; + MinGrid.ColCount := value; + EqualGrid.ColCount := value; + NoVars := value; + SetLength(Objective,NoVars + 1); +end; + +procedure TLinProFrm.NoVarsEditKeyPress(Sender: TObject; var Key: char); +begin + if ord(Key) = 13 then NoMaxEdit.SetFocus; +end; + +PROCEDURE TLinProFrm.simplx(VAR a: DblDyneMat; m,n,mp,np,m1,m2,m3: integer; + VAR icase: integer; VAR izrov: IntDyneVec; + VAR iposv: IntDyneVec); +LABEL 1,2,10,20,30,99; +CONST eps=1.0e-6; +VAR + nl2,nl1,m12,kp,kh,k,is1,ir,ip,i: integer; + q1,bmax: double; + l1: IntDyneVec; + l2,l3: IntDyneVec; +BEGIN + setlength(l1,np+1); + setlength(l2,mp + 1); + setlength(l3,mp + 1); + IF (m <> (m1+m2+m3)) THEN BEGIN + writeln('pause in routine SIMPLX'); + writeln('bad input constraint counts'); readln + END; + nl1 := n; + FOR k := 1 TO n DO BEGIN + l1[k] := k; + izrov[k] := k + END; + nl2 := m; + FOR i := 1 TO m DO BEGIN + IF (a[i+1,1] < 0.0) THEN BEGIN + writeln('pause in routine SIMPLX'); + writeln('bad input tableau'); readln + END; + l2[i] := i; + iposv[i] := n+i + END; + FOR i := 1 TO m2 DO BEGIN + l3[i] := 1 + END; + ir := 0; + IF ((m2+m3) = 0) THEN GOTO 30; + ir := 1; + FOR k := 1 TO n+1 DO BEGIN + q1 := 0.0; + FOR i := m1+1 TO m DO BEGIN + q1 := q1+a[i+1,k] + END; + a[m+2,k] := -q1 + END; +10: simp1(a,mp,np,m+1,l1,nl1,0,kp,bmax); + IF ((bmax <= eps) AND (a[m+2,1] < -eps)) THEN BEGIN + icase := -1; GOTO 99 END + ELSE IF ((bmax <= eps) AND (a[m+2,1] <= eps)) THEN BEGIN + m12 := m1+m2+1; + IF (m12 <= m) THEN BEGIN + FOR ip := m12 TO m DO BEGIN + IF (iposv[ip] = (ip+n)) THEN BEGIN + simp1(a,mp,np,ip,l1,nl1,1,kp,bmax); + IF (bmax > 0.0) THEN GOTO 1 + END + END + END; + ir := 0; + m12 := m12-1; + IF ((m1+1) > m12) THEN GOTO 30; + FOR i := m1+1 TO m12 DO BEGIN + IF (l3[i-m1] = 1) THEN BEGIN + FOR k := 1 TO n+1 DO BEGIN + a[i+1,k] := -a[i+1,k] + END + END + END; + GOTO 30 + END; + simp2(a,m,n,mp,np,l2,nl2,ip,kp,q1); + IF (ip = 0) THEN BEGIN + icase := -1; GOTO 99 + END; +1: simp3(a,mp,np,m+1,n,ip,kp); + IF (iposv[ip] >= (n+m1+m2+1)) THEN BEGIN + FOR k := 1 TO nl1 DO BEGIN + IF (l1[k] = kp) THEN GOTO 2 + END; +2: nl1 := nl1-1; + FOR is1 := k TO nl1 DO BEGIN + l1[is1] := l1[is1+1] + END + END ELSE BEGIN + IF (iposv[ip] < (n+m1+1)) THEN GOTO 20; + kh := iposv[ip]-m1-n; + IF (l3[kh] = 0) THEN GOTO 20; + l3[kh] := 0 + END; + a[m+2,kp+1] := a[m+2,kp+1]+1.0; + FOR i := 1 TO m+2 DO BEGIN + a[i,kp+1] := -a[i,kp+1] + END; +20: is1 := izrov[kp]; + izrov[kp] := iposv[ip]; + iposv[ip] := is1; + IF (ir <> 0) THEN GOTO 10; +30: simp1(a,mp,np,0,l1,nl1,0,kp,bmax); + IF (bmax <= 0.0) THEN BEGIN + icase := 0; GOTO 99 + END; + simp2(a,m,n,mp,np,l2,nl2,ip,kp,q1); + IF (ip = 0) THEN BEGIN + icase := 1; GOTO 99 + END; + simp3(a,mp,np,m,n,ip,kp); + GOTO 20; +99: + l1 := nil; + l2 := nil; + l3 := nil; +END; + + +PROCEDURE TLinProFrm.simp1(VAR a: DblDyneMat; mp,np,mm: integer; + ll: IntDyneVec; nll,iabf: integer; + VAR kp: integer; VAR bmax: double); +LABEL 99; +VAR + k: integer; + test: real; +BEGIN + kp := ll[1]; + bmax := a[mm+1,kp+1]; + IF (nll < 2) THEN GOTO 99; + FOR k := 2 TO nll DO BEGIN + IF (iabf = 0) THEN BEGIN + test := a[mm+1,ll[k]+1]-bmax + END ELSE BEGIN + test := abs(a[mm+1,ll[k]+1])-abs(bmax) + END; + IF (test > 0.0) THEN BEGIN + bmax := a[mm+1,ll[k]+1]; + kp := ll[k] + END + END; +99: END; + + +PROCEDURE TLinProFrm.simp2(VAR a: DblDyneMat; m,n,mp,np: integer; + l2: IntDyneVec; nl2: integer; VAR ip: integer; + kp: integer; VAR q1: double); +LABEL 2,6,99; +VAR + k,ii,i: integer; + qp,q0,q: double; +BEGIN + ip := 0; + IF (nl2 < 1) THEN GOTO 99; + FOR i := 1 TO nl2 DO BEGIN + IF (a[l2[i]+1,kp+1] < 0.0) THEN GOTO 2 + END; + GOTO 99; +2: q1 := -a[l2[i]+1,1]/a[l2[i]+1,kp+1]; + ip := l2[i]; + IF ((i+1) > nl2) THEN GOTO 99; + FOR i := i+1 TO nl2 DO BEGIN + ii := l2[i]; + IF (a[ii+1,kp+1] < 0.0) THEN BEGIN + q := -a[ii+1,1]/a[ii+1,kp+1]; + IF (q < q1) THEN BEGIN + ip := ii; + q1 := q + END ELSE IF (q = q1) THEN BEGIN + FOR k := 1 TO n DO BEGIN + qp := -a[ip+1,k+1]/a[ip+1,kp+1]; + q0 := -a[ii+1,k+1]/a[ii+1,kp+1]; + IF (q0 <> qp) THEN GOTO 6 + END; +6: IF (q0 < qp) THEN ip := ii + END + END + END; +99: +end; + + +PROCEDURE TLinProFrm.simp3(VAR a: DblDyneMat; mp,np,i1,k1,ip,kp: integer); +(* Programs using routine SIMP3 must define the type +TYPE + glmpbynp = ARRAY [1..mp,1..np] OF real; +in the main routine. *) +VAR + kk,ii: integer; + piv: double; +BEGIN + piv := 1.0/a[ip+1,kp+1]; + IF (i1 >= 0) THEN BEGIN + FOR ii := 1 TO (i1+1) DO BEGIN + IF ((ii-1) <> ip) THEN BEGIN + a[ii,kp+1] := a[ii,kp+1]*piv; + FOR kk := 1 TO k1+1 DO BEGIN + IF ((kk-1) <> kp) THEN BEGIN + a[ii,kk] := a[ii,kk] + -a[ip+1,kk]*a[ii,kp+1] + END + END + END + END + END; + FOR kk := 1 TO k1+1 DO BEGIN + IF ((kk-1) <> kp) THEN a[ip+1,kk] := -a[ip+1,kk]*piv + END; + a[ip+1,kp+1] := piv +END; + + +procedure TLinProFrm.LoadArrayData(Sender: TObject); +var + i, j : integer; +begin + // load objectives + for i := 1 to NoVars do Objective[i] := StrToFloat(ObjectiveGrid.Cells[i-1,0]); + + // load constraints + for i := 1 to NoMax do + begin + MaxConstraints[i] := StrToFloat(MaxConstraintsGrid.Cells[0,i-1]); + for j := 1 to NoVars do coefficients[i,j] := StrToFloat(MaxGrid.Cells[j-1,i-1]); + end; + for i := 1 to NoMin do + begin + MinConstraints[i] := StrToFloat(MinConstraintsGrid.Cells[0,i-1]); + for j := 1 to NoVars do coefficients[i+NoMax,j] := StrToFloat(MinGrid.Cells[j-1,i-1]); + end; + for i := 1 to NoEql do + begin + EqlConstraints[i] := StrToFloat(EqualConstraintsGrid.Cells[0,i-1]); + for j := 1 to NoVars do coefficients[i+NoMax+NoMin,j] := StrToFloat(EqualGrid.Cells[j-1,i-1]); + end; + + // Set for minimization if requested + if MinMaxGrp.ItemIndex = 1 then MinMax := 1; +end; + + +initialization + {$I linprounit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/logregunit.lfm b/applications/lazstats/source/forms/analysis/multiple_regression/logregunit.lfm new file mode 100644 index 000000000..01ed05848 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/logregunit.lfm @@ -0,0 +1,303 @@ +object LogRegFrm: TLogRegFrm + Left = 876 + Height = 355 + Top = 245 + Width = 353 + AutoSize = True + Caption = 'Binary Logistic Regression' + ClientHeight = 355 + ClientWidth = 353 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = DepVar + AnchorSideBottom.Control = DepVar + Left = 198 + Height = 15 + Top = 31 + Width = 102 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = BlockList + AnchorSideTop.Control = InBtn + Left = 198 + Height = 15 + Top = 120 + Width = 116 + Caption = 'Independent Variables' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrCenter + Left = 179 + Height = 15 + Top = 247 + Width = 107 + BorderSpacing.Left = 16 + Caption = 'Maximum Iterations' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepInBtn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 170 + Top = 25 + Width = 146 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object DepInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 162 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInBtnClick + Spacing = 0 + TabOrder = 1 + end + object DepOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepInBtn + AnchorSideTop.Side = asrBottom + Left = 162 + Height = 28 + Top = 55 + Width = 28 + BorderSpacing.Top = 2 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 162 + Height = 28 + Top = 120 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 4 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 162 + Height = 28 + Top = 148 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 5 + end + object DepVar: TEdit + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOutBtn + AnchorSideBottom.Side = asrBottom + Left = 198 + Height = 23 + Top = 48 + Width = 147 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'DepVar' + end + object BlockList: TListBox + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 198 + Height = 60 + Top = 135 + Width = 147 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 6 + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 103 + Top = 203 + Width = 155 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ClientHeight = 83 + ClientWidth = 151 + TabOrder = 7 + object DescChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 127 + Caption = 'Descriptive Statistics' + TabOrder = 0 + end + object ProbsChk: TCheckBox + Left = 12 + Height = 19 + Top = 32 + Width = 95 + Caption = 'Y Probabilities' + TabOrder = 1 + end + object ItersChk: TCheckBox + Left = 12 + Height = 19 + Top = 58 + Width = 101 + Caption = 'Show Iterations' + TabOrder = 2 + end + end + object MaxItsEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrCenter + Left = 294 + Height = 23 + Top = 243 + Width = 38 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + TabOrder = 8 + Text = 'MaxItsEdit' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 140 + Height = 25 + Top = 322 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 9 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 202 + Height = 25 + Top = 322 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 10 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 286 + Height = 25 + Top = 322 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 11 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 306 + Width = 353 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/logregunit.pas b/applications/lazstats/source/forms/analysis/multiple_regression/logregunit.pas new file mode 100644 index 000000000..83f2d6606 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/logregunit.pas @@ -0,0 +1,629 @@ +unit LogRegUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + Globals, MainUnit, OutputUnit; + +type + + { TLogRegFrm } + + TLogRegFrm = class(TForm) + Bevel1: TBevel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + DepInBtn: TBitBtn; + DepOutBtn: TBitBtn; + MaxItsEdit: TEdit; + InBtn: TBitBtn; + Label4: TLabel; + OutBtn: TBitBtn; + DescChk: TCheckBox; + ProbsChk: TCheckBox; + ItersChk: TCheckBox; + DepVar: TEdit; + GroupBox1: TGroupBox; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + BlockList: TListBox; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure DepInBtnClick(Sender: TObject); + procedure DepOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + function ChiSq(x : double; n : integer) : double; + function Norm(z : double): double; + function ix(j, k, nCols : integer): integer; + procedure VarListSelectionChange(Sender: TObject; User: boolean); + + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + LogRegFrm: TLogRegFrm; + +implementation + +uses + Math; + +{ TLogRegFrm } + +procedure TLogRegFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + BlockList.Clear; + VarList.Clear; + for i := 1 to NoVariables do + begin + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + end; + InBtn.Enabled := true; + OutBtn.Enabled := false; + DepInBtn.Enabled := true; + DepOutBtn.Enabled := false; + ProbsChk.Checked := true; + DescChk.Checked := true; + DepVar.Text := ''; + MaxItsEdit.Text := '20'; +end; + +procedure TLogRegFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TLogRegFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + BlockList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end + else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TLogRegFrm.DepInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepVar.Text = '') then + begin + DepVar.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TLogRegFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k : integer; + cellstring : string; + outline : string; + nR : integer; // no. independent variables + ColNoSelected : IntDyneVec; + nC : integer; // no. cases + nP : integer; // total no. variables + RowLabels, ColLabels : StrDyneVec; + nP1 : integer; // total no. variables plus 1 + sY0, sY1 : integer; // sum of cases with dependent of 0 or 1 + sC : integer; // total count of cases with 0 or 1 + X : DblDyneVec; // data matrix for independent variables + Y0, Y1 : DblDyneVec; // data array for dependent data + xM : DblDyneVec; // variable means + xSD : DblDyneVec; // variable standard deviations + Par : DblDyneVec; // work array + SEP : DblDyneVec; // work array; + Arr : DblDyneVec; // work array; + indx, indx2, indx3 : integer; // indexes for arrays + value : double; + LLp, LL, LLn : double; // log likelihood + q : double; // work values + xij, s : double; // work value + CSq : double; // chi square statistic + prob : double; // probability of chi square + ORc, OR1, ORh : double; // Odds ratio values + iters : integer; + Table : array[1..3,1..3] of integer; + row, col : integer; + maxIts: Integer; + lReport: TStrings; +begin + lReport := TStringList.Create; + try + lReport.Add('LOGISTIC REGRESSION, adapted from John C. Pezzullo'); + lReport.Add('Java program at http://members.aol.com/johnp71/logistic.html'); + + { get independent item columns } + nR := BlockList.Items.Count; + nC := NoCases; + SetLength(ColNoSelected,nR + 2); + SetLength(RowLabels,nR + 2); + SetLength(ColLabels,nR + 2); + if nR < 1 then + begin + MessageDlg('No independent variables selected.', mtError, [mbOK], 0); + exit; + end; + + for i := 1 to nR do + begin + cellstring := BlockList.Items.Strings[i-1]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[i] := j; + RowLabels[i] := cellstring; + ColLabels[i] := cellstring; + end; + end; + end; + + { get dependendent variable column } + if DepVar.Text = '' then + begin + MessageDlg('No dependent variable selected.', mtError, [mbOK], 0); + exit; + end; + + if MaxItsEdit.Text = '' then begin + MaxItsEdit.Setfocus; + MessageDlg('Maximum iterations not specified.', mtError, [mbOK], 0); + exit; + end; + + if not TryStrToInt(MaxItsEdit.Text, maxIts) then + begin + MaxItsEdit.SetFocus; + MessageDlg('No valid number given for maximum iterations.', mtError, [mbOK], 0); + exit; + end; + + + nP := nR + 1; + nP1 := nP + 1; + for j := 1 to NoVariables do + begin + if DepVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[nP] := j; + RowLabels[nP] := OS3MainFrm.DataGrid.Cells[j,0]; + ColLabels[nP] := RowLabels[nP]; + end; + end; + + sY0 := 0; + sY1 := 0; + sC := 0; + SetLength(X,(nC + 1) * (nR + 1)); + SetLength(Y0,nC + 1); + SetLength(Y1,nC + 1); + SetLength(xM,nR + 2); + SetLength(xSD,nR + 2); + SetLength(Par,nP + 1); + SetLength(SEP,nP + 1); + SetLength(Arr,(nP + 1) * (nP1 + 1)); + + // get data + for i := 0 to nC - 1 do + begin + indx := ix(i,0,nR+1); + X[indx] := 1; + for j := 1 to nR do + begin + indx := ColNoSelected[j]; + value := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1])); + indx := ix(i,j,nR + 1); + X[indx] := value; + end; + indx := ColNoSelected[nP]; + value := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[indx,i+1])); + if value = 0 then + begin + Y0[i] := 1; + sY0 := sY0 + 1; + end + else begin + Y1[i] := 1; + sY1 := sY1 + 1; + end; + sC := sC + round(Y0[i] + Y1[i]); + for j := 1 to nR do + begin + indx := ix(i,j,nR + 1); + value := X[indx]; + xM[j] := xM[j] + (Y0[i] + Y1[i]) * value; + xSD[j] := xSD[j] + (Y0[i] + Y1[i]) * value * value; + end; + end; // next case i + + // print descriptive statistics + lReport.Add(''); + if DescChk.Checked then + lReport.Add('Descriptive Statistics'); + lReport.Add('%d cases have Y=0; %d cases have Y=1.', [sY0, sY1]); + lReport.Add(''); + lReport.Add('Variable Label Average Std.Dev.'); + for j := 1 to nR do + begin + xM[j] := xM[j] / sC; + xSD[j] :=xSD[j] / sC; + xSD[j] := sqrt( abs(xSD[j] - xM[j] * xM[j])); + if DescChk.Checked then + lReport.Add(' %3d %15s %10.4f %10.4f',[j,RowLabels[j],xM[j],xSD[j]]); + end; + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + xM[0] := 0.0; + xSD[0] := 1.0; + //OutputFrm.ShowModal; + + // convert independent variable values to z scores + for i := 0 to nC - 1 do + begin + for j := 1 to nR do + begin + indx := ix(i,j,nR + 1); + X[indx] := (X[indx] - xM[j]) / xSD[j]; + end; + end; + + // begin iterations + iters := 0; + if ItersChk.Checked then + lReport.Add('Iteration History'); + Par[0] := ln(sY1 / sY0); + for j := 1 to nR do Par[j] := 0.0; + LLp := 2e10; + LL := 1e10; + while abs(LLp-LL) > 0.00001 do + begin + iters := iters + 1; + if iters > StrToInt(MaxItsEdit.Text) then break; + LLp := LL; + LL := 0.0; + for j := 0 to nR do + begin + for k := j to nR + 1 do + begin + indx := ix(j,k,nR+2); + Arr[indx] := 0.0; + end; + end; + for i := 0 to nC - 1 do + begin + value := Par[0]; + for j := 1 to nR do + begin + indx := ix(i,j,nR + 1); + value := value + Par[j] * X[indx]; + end; + value := 1.0 / (1.0 + exp(-value)); + q := value * (1.0 - value); + LL := LL - 2.0 * Y1[i] * ln(value) - 2.0 * Y0[i] * ln(1.0 - value); + for j := 0 to nR do + begin + indx := ix(i,j,nR + 1); + xij := X[indx]; + indx := ix(j,nR + 1, nR + 2); + Arr[indx] := Arr[indx] + xij * ( Y1[i] * (1.0 - value) + Y0[i] * (-value)); + for k := j to nR do + begin + indx := ix(j,k,nR + 2); + indx2 := ix(i,k,nR + 1); + Arr[indx] := Arr[indx] + xij * X[indx2] * q * (Y0[i] + Y1[i]); + end; + end; // next j + end; // next i + outline := format('-2 Log Likelihood = %10.4f ',[LL]); + if LLp = 1.0e10 then + begin + LLn := LL; + outline := outline + ' (Null Model)'; + end; + if ItersChk.Checked then lReport.Add(outline); + for j := 1 to nR do + begin + for k := 0 to j-1 do + begin + indx := ix(j,k,nR + 2); + indx2 := ix(k,j,nR + 2); + Arr[indx] := Arr[indx2]; + end; + end; + for i := 0 to nR do + begin + indx := ix(i,i,nR + 2); + s := Arr[indx]; + Arr[indx] := 1.0; + for k := 0 to nR + 1 do + begin + indx := ix(i,k,nR + 2); + Arr[indx] := Arr[indx] / s; + end; + for j := 0 to nR do + begin + if i <> j then + begin + indx := ix(j,i,nR + 2); + s := Arr[indx]; + Arr[indx] := 0.0; + for k := 0 to nR + 1 do + begin + indx2 := ix(j,k,nR + 2); + indx3 := ix(i,k,nR + 2); + Arr[indx2] := Arr[indx2] - s * Arr[indx3]; + end; // next k + end; // if i not equal j + end; // next j + end; // next i + for j := 0 to nR do + begin + indx := ix(j,nR + 1,nR + 2); + Par[j] := Par[j] + Arr[indx]; + end; + end; // iteration + lReport.Add('Converged'); + lReport.Add(''); + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + + CSq := LLn - LL; + prob := ChiSq(CSq,nR); + lReport.Add('Overall Model Fit... Chi Square = %8.4f with df = %3d and prob. = %8.4f', [Csq, nR, prob]); + lReport.Add(''); + lReport.Add('Coefficients and Standard Errors...'); + lReport.Add('Variable Label Coeff. StdErr p'); + for j := 1 to nR do + begin + Par[j] := Par[j] / xSD[j]; + indx := ix(j,j,nP + 1); + SEP[j] := sqrt(Arr[indx]) / xSD[j]; + Par[0] := Par[0] - Par[j] * xM[j]; + prob := Norm(abs(Par[j] / SEP[j])); + lReport.Add(' %3d %15s %10.4f %10.4f %10.4f', [j, RowLabels[j], Par[j], SEP[j], prob]); + end; + lReport.Add(''); +// OutputFrm.ShowModal; + + lReport.Add('Intercept %10.4f', [Par[0]]); + lReport.Add(''); + lReport.Add('Odds Ratios and 95% Confidence Intervals...'); + lReport.Add('Variable O.R. Low -- High'); + for j := 1 to nR do + begin + ORc := exp(Par[j]); + OR1 := exp(Par[j] - 1.96 * SEP[j]); + ORh := exp(Par[j] + 1.96 * SEP[j]); + lReport.Add('%15s %10.4f %10.4f %10.4f', [RowLabels[j], ORc, OR1, ORh]); + end; + for i := 1 to 3 do + for j := 1 to 3 do Table[i,j] := 0; + lReport.Add(''); + outline := ''; + if ProbsChk.Checked then + begin + for j := 1 to nR do outline := outline + ' X '; + outline := outline + ' Y Prob'; + lReport.Add(outline); + for i := 0 to nC - 1 do + begin + value := Par[0]; + outline := ''; + for j := 1 to nR do + begin + indx := ix(i,j,nR + 1); + xij := xM[j] + xSD[j] * X[indx]; + value := value + Par[j] * xij; + outline := outline + format(' %10.4f ',[xij]); + end; + value := 1.0 / (1.0 + exp( -value)); + outline := outline + format('%4.0f %10.4f',[Y1[i],value]); + lReport.Add(outline); + if round(Y1[i]) = 0 then row := 1 else row := 2; + if round(value) = 0 then col := 1 else col := 2; + Table[row,col] := Table[row,col] + 1; + end; // next i + end; + for i := 1 to 2 do + begin + for j := 1 to 2 do + begin + Table[i,3] := Table[i,3] + Table[i,j]; + Table[3,j] := Table[3,j] + Table[i,j]; + end; + end; + for i := 1 to 2 do Table[3,3] := Table[3,3] + Table[i,3]; + lReport.Add(''); + lReport.Add('Classification Table'); + lReport.Add(' Predicted'); + lReport.Add(' --------------- '); + lReport.Add('Observed 0 1 Total'); + lReport.Add(' --------------- '); + for i := 1 to 2 do + begin + outline := format(' %d ',[i-1]); + for j := 1 to 3 do outline := outline + format('| %3d ',[Table[i,j]]); + outline := outline + '|'; + lReport.Add(outline); + end; + lReport.Add(' --------------- '); + Outline := 'Total '; + for j := 1 to 3 do outline := outline + format('| %3d ',[Table[3,j]]); + outline := outline + ''; + lReport.Add(outline); + lReport.Add(' --------------- '); + + DisplayReport(lReport); + + finally + lReport.Free; + Arr := nil; + SEP := nil; + Par := nil; + xSD := nil; + xM := nil; + Y1 := nil; + Y0 := nil; + X := nil; + RowLabels := nil; + ColLabels := nil; + ColNoSelected := nil; + end; +end; + +procedure TLogRegFrm.DepOutBtnClick(Sender: TObject); +begin + if DepVar.Text <> '' then + begin + VarList.Items.Add(DepVar.Text); + DepVar.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TLogRegFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinHeight := OutBtn.Top + OutBtn.Height - VarList.Top; + + Constraints.MinHeight := Height; + Constraints.MinWidth := MaxItsEdit.Left + MaxItsEdit.Width + MaxItsEdit.BorderSpacing.Right; +// Constraints.MinWidth := Width; + + FAutoSized := true; +end; + +procedure TLogRegFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TLogRegFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TLogRegFrm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < BlockList.Items.Count do + begin + if BlockList.Selected[i] then + begin + VarList.Items.Add(BlockList.Items[i]); + BlockList.Items.Delete(i); + i := 0; + end + else + inc(i); + end; + UpdateBtnStates; +end; + +function TLogRegFrm.ChiSq(x : double; n : integer) : double; +var + p, t, a : double; + k : integer; + +begin + p := exp(-0.5 * x); + if n mod 2 = 1 then p := p * sqrt(2 * x / Pi); + k := n; + while K >= 2 do + begin + p := p * x / k; + k := k - 2; + end; + t := p; + a := n; + while t > 0.000001 * p do + begin + a := a + 2; + t := t * x / a; + p := p + t; + end; + ChiSq := (1 - p); +end; + +function TLogRegFrm.Norm(z : double): double; +begin + Norm := ChiSq(z * z, 1); +end; + +function TLogRegFrm.ix(j, k, nCols : integer): integer; +begin + ix := j * nCols + k; +end; + +procedure TLogRegFrm.UpdateBtnStates; +var + i: Integer; + lSelected: Boolean; +begin + lSelected := false; + for i:=0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + DepInBtn.Enabled := lSelected and (DepVar.Text = ''); + InBtn.Enabled := lSelected; + DepOutBtn.Enabled := DepVar.Text <> ''; + + lSelected := false; + for i := 0 to BlockList.Items.Count-1 do + if BlockList.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; +end; + + +initialization + {$I logregunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/lsmrunit.lfm b/applications/lazstats/source/forms/analysis/multiple_regression/lsmrunit.lfm new file mode 100644 index 000000000..219bf26b8 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/lsmrunit.lfm @@ -0,0 +1,365 @@ +object LSMregForm: TLSMregForm + Left = 439 + Height = 413 + Top = 192 + Width = 740 + AutoSize = True + Caption = 'Standard Least-Squares Multiple Regression' + ClientHeight = 413 + ClientWidth = 740 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 339 + Top = 25 + Width = 222 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object DepInBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + AnchorSideRight.Control = DepVar + Left = 247 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInBtnClick + Spacing = 0 + TabOrder = 1 + end + object Label2: TLabel + AnchorSideLeft.Control = DepVar + AnchorSideTop.Control = DepInBtn + Left = 292 + Height = 15 + Top = 25 + Width = 102 + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + ParentColor = False + end + object DepVar: TEdit + AnchorSideLeft.Control = IndepVars + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideBottom.Side = asrBottom + Left = 292 + Height = 23 + Top = 42 + Width = 198 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Right = 16 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'DepVar' + end + object Label3: TLabel + AnchorSideLeft.Control = IndepVars + AnchorSideTop.Control = DepVar + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = IndepVars + Left = 292 + Height = 15 + Top = 97 + Width = 166 + BorderSpacing.Top = 32 + BorderSpacing.Bottom = 2 + Caption = 'Independent Var.s for this block' + ParentColor = False + end + object Label5: TLabel + AnchorSideTop.Control = InProb + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = InProb + Left = 511 + Height = 15 + Top = 12 + Width = 163 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Minimum Prob. to enter block:' + ParentColor = False + end + object GroupBox1: TGroupBox + AnchorSideTop.Control = InProb + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 506 + Height = 212 + Top = 39 + Width = 226 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 4 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 192 + ClientWidth = 222 + TabOrder = 9 + object CPChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 198 + Caption = 'Show Cross-Products Matrix' + TabOrder = 0 + end + object CovChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 29 + Width = 198 + Caption = 'Show Variance-Covariance Matrix' + TabOrder = 1 + end + object CorrsChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 52 + Width = 198 + Caption = 'Show Intercorrelation Matrix' + TabOrder = 2 + end + object MeansChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 75 + Width = 198 + Caption = 'Show Means' + TabOrder = 3 + end + object VarChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 98 + Width = 198 + Caption = 'Show Variances' + TabOrder = 4 + end + object SDChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 121 + Width = 198 + Caption = 'Show Standard Deviations' + TabOrder = 5 + end + object MatSaveChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 144 + Width = 198 + Caption = 'Save Correlation Matrix' + TabOrder = 6 + end + object PredictChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 167 + Width = 198 + Caption = 'Predictions,residuals,C.I.''s to Grid' + TabOrder = 7 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 531 + Height = 25 + Top = 380 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 10 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 677 + Height = 25 + Top = 380 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 12 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 593 + Height = 25 + Top = 380 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 11 + end + object IndepVars: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideBottom.Control = Bevel1 + Left = 292 + Height = 250 + Top = 114 + Width = 198 + Anchors = [akTop, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 16 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 7 + end + object DepOutBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepInBtn + AnchorSideTop.Side = asrBottom + Left = 247 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = OutBtn + Left = 247 + Height = 28 + Top = 193 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 4 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = IndepVars + AnchorSideTop.Side = asrCenter + Left = 247 + Height = 28 + Top = 225 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 5 + end + object AllBtn: TBitBtn + AnchorSideTop.Control = OutBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = IndepVars + Left = 238 + Height = 25 + Top = 257 + Width = 46 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 4 + Caption = 'ALL' + OnClick = AllBtnClick + TabOrder = 6 + end + object InProb: TEdit + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 682 + Height = 23 + Top = 8 + Width = 50 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 8 + Text = 'InProb' + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 364 + Width = 740 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 8 + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/lsmrunit.pas b/applications/lazstats/source/forms/analysis/multiple_regression/lsmrunit.pas new file mode 100644 index 000000000..0d1bfee71 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/lsmrunit.pas @@ -0,0 +1,452 @@ +unit LSMRUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, Globals, MainUnit, MatrixLib, OutPutUnit, + FunctionsLib, DataProcs, DictionaryUnit; + +type + + { TLSMregForm } + + TLSMregForm = class(TForm) + AllBtn: TBitBtn; + Bevel1: TBevel; + IndepVars: TListBox; + ComputeBtn: TButton; + CorrsChkBox: TCheckBox; + CovChkBox: TCheckBox; + CPChkBox: TCheckBox; + DepInBtn: TBitBtn; + DepOutBtn: TBitBtn; + DepVar: TEdit; + GroupBox1: TGroupBox; + InBtn: TBitBtn; + InProb: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label5: TLabel; + MatSaveChkBox: TCheckBox; + MeansChkBox: TCheckBox; + SaveDialog1: TSaveDialog; + OutBtn: TBitBtn; + PredictChkBox: TCheckBox; + ResetBtn: TButton; + CloseBtn: TButton; + SDChkBox: TCheckBox; + VarChkBox: TCheckBox; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure DepInBtnClick(Sender: TObject); + procedure DepOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: boolean; + IndepVarsCols : IntDyneVec; + NoVars : integer; + NoBlocks : integer; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + LSMregForm: TLSMregForm; + +implementation + +uses + Math; + +procedure TLSMregForm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + IndepVars.Items.Clear; + VarList.Items.Clear; + NoBlocks := 1; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + + CPChkBox.Checked := false; + CovChkBox.Checked := false; + CorrsChkBox.Checked := true; + MeansChkBox.Checked := true; + VarChkBox.Checked := false; + SDChkBox.Checked := true; + MatSaveChkBox.Checked := false; + PredictChkBox.Checked := false; + + NoVars := 0; + DepVar.Text := ''; + InProb.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL); + SetLength(IndepVarsCols, NoVariables+1); + + UpdateBtnStates; +end; + +procedure TLSMregForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinWidth := IndepVars.Width; + IndepVars.Constraints.MinHeight := Max(200, GroupBox1.Top + GroupBox1.Height - IndepVars.Top); + + Constraints.MinHeight := Height; + Constraints.MinWidth := Width; + + FAutoSized := true; +end; + +procedure TLSMregForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TLSMregForm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TLSMregForm.AllBtnClick(Sender: TObject); +var + index: integer; +begin + for index := 0 to VarList.Items.Count-1 do + IndepVars.Items.Add(VarList.Items.Strings[index]); + VarList.Clear; + UpdateBtnStates; +end; + +procedure TLSMregForm.ComputeBtnClick(Sender: TObject); +Label CleanUp; +var + i, j, NCases: integer; + NoIndepVars, DepVarCol, NEntered: integer; + R2, df1, df2: double; + StdErrEst, F, FProbF, OldR2 : double; + pdf1, pdf2, probin, prout : double; + errorcode : boolean; + BetaWeights : DblDyneVec; + BWeights : DblDyneVec; + BStdErrs : DblDyneVec; + Bttests : DblDyneVec; + tProbs : DblDyneVec; + cellstring: string; + corrs : DblDyneMat; + Means : DblDyneVec; + Variances : DblDyneVec; + StdDevs : DblDyneVec; + title : string; + IndRowLabels : StrDyneVec; + IndColLabels : StrDyneVec; + IndepInverse : DblDyneMat; + ColEntered : IntDyneVec; + filename : string; + constant : double; + errcode: boolean = false; + anerror: Integer = 0; + lReport: TStrings; +begin + NCases := NoCases; + SetLength(corrs,NoVariables+1,NoVariables+1); + SetLength(IndepInverse,NoVariables,NoVariables+1); + SetLength(IndepVarsCols,NoVariables+1); + SetLength(BWeights,NoVariables+1); + SetLength(BStdErrs,NoVariables+1); + SetLength(Bttests,NoVariables+1); + SetLength(tProbs,NoVariables+1); + SetLength(Means,NoVariables+1); + SetLength(Variances,NoVariables+1); + SetLength(StdDevs,NoVariables+1); + SetLength(IndepVarsCols,NoVariables+1); + SetLength(IndColLabels,NoVariables+1); + SetLength(IndRowLabels,NoVariables+1); + SetLength(BetaWeights,NoVariables+1); + SetLength(ColEntered,NoVariables+2); + probin := StrToFloat(InProb.Text); // probability to include a block + prout := 1.0; + + if DepVar.Text = '' then + begin + MessageDlg('No dependent variable selected.', mtError, [mbOK], 0); + exit; + end; + if IndepVars.Items.Count = 0 then + begin + MessageDlg('No independent variable selected.', mtError, [mbOK], 0); + exit; + end; + + lReport := TStringList.Create; + try + lReport.Add('LEAST SQUARES MULTIPLE REGRESSION by Bill Miller'); + lReport.Add(''); + errorcode := false; + + { get dependendent variable column } + DepVarCol := 0; + NoVars := NoVars + 1; + for j := 1 to NoVariables do + if DepVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then DepVarCol := j; + + R2 := 0.0; + OldR2 := 0.0; + pdf1 := 0.0; + pdf2 := 0.0; + NEntered := 0; + + { get independendent variable column } + for i := 0 to IndepVars.Count-1 do + begin + //cellstring := OS3Mainfrm.DataGrid.Cells[i+1,0]; // bug + cellstring := IndepVars.Items[i]; //Bugfix by tatamata + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + begin + IndepVarsCols[i] := j; + ColEntered[i] := j; + NEntered := NEntered + 1; + IndRowLabels[NEntered-1] := cellstring; + IndColLabels[NEntered-1] := cellstring; + end; + end; + end; + NEntered := NEntered + 1; // dependent variable last + ColEntered[NEntered-1] := DepVarCol; + IndRowLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[DepVarCol,0]; + IndColLabels[NEntered-1] := OS3MainFrm.DataGrid.Cells[DepVarCol,0]; + + if CPChkBox.Checked then + begin + title := 'Cross-Products Matrix'; + GridXProd(NEntered, ColEntered, Corrs, errcode, NCases); + MatPrint(Corrs, NEntered, NEntered, title, IndRowLabels, IndColLabels, NCases, lReport); + lReport.Add('--------------------------------------------------------------------'); + end; + + if CovChkBox.Checked then + begin + title := 'Variance-Covariance Matrix'; + GridCovar(NEntered,ColEntered, Corrs, Means, Variances, StdDevs, errcode, NCases); + MatPrint(Corrs, NEntered, NEntered, title, IndRowLabels, IndColLabels, NCases, lReport); + lReport.Add('--------------------------------------------------------------------'); + end; + Correlations(NEntered,ColEntered,Corrs,Means,Variances, StdDevs,errcode,NCases); + + if CorrsChkBox.Checked then + begin + title := 'Product-Moment Correlations Matrix'; + MatPrint(Corrs, NEntered, NEntered, title, IndRowLabels, IndColLabels, NCases, lReport); + lReport.Add('--------------------------------------------------------------------'); + end; + + if MeansChkBox.Checked then + begin + title := 'Means'; + DynVectorPrint(Means, NEntered, title, IndColLabels, NCases, lReport); + lReport.Add('--------------------------------------------------------------------'); + end; + + if VarChkBox.Checked = true then + begin + title := 'Variances'; + DynVectorPrint(Variances, NEntered, title, IndColLabels, NCases, lReport); + lReport.Add('--------------------------------------------------------------------'); + end; + + if SDChkBox.Checked = true then + begin + title := 'Standard Deviations'; + DynVectorPrint(StdDevs, NEntered, title, IndColLabels, NCases, lReport); + lReport.Add('--------------------------------------------------------------------'); + end; + + if errorcode then + begin + MessageDlg('A selected variable has no variability. Run aborted.', mtError, [mbOK], 0); + exit; + end; + NoIndepVars := NEntered - 1; + + MReg(NoIndepVars, ColEntered, DepVarCol, IndRowLabels, Means, Variances, + StdDevs, BWeights, BetaWeights, BStdErrs, Bttests, tProbs, R2, + StdErrEst, NCases, errorcode, true, lReport); + + df1 := NoIndepVars - pdf1; + df2 := NCases - NoIndepVars - 1; + F := ((R2 - OldR2) / (1.0 - R2)) * df2 / df1; + FProbF := probf(F,df1,df2); + if FProbF < probin then + lReport.Add('Entry requirements met') + else + lReport.Add('Entry requirements not met'); + + lReport.Add(''); + lReport.Add('===================================================================='); + lReport.Add(''); + + { add [predicted scores, residual scores, etc. to grid if options elected } + if PredictChkBox.Checked then + begin + prout := 1.0; + Correlations(NEntered, ColEntered, Corrs, Means, Variances, StdDevs, errcode, NCases); + + MReg2(NCases, NEntered, NoIndepVars, ColEntered, corrs, IndepInverse, + IndRowLabels, R2, BetaWeights, Means, Variances, anerror, + StdErrEst, constant, prout, true, false, false, lReport); + + Predict(ColEntered, NEntered, IndepInverse, Means, StdDevs, + BetaWeights, StdErrEst, IndepVarsCols, NoIndepVars); + end; + +// OutputFrm.ShowModal; +// OutputFrm.RichEdit.Clear; + + if MatSaveChkBox.Checked then + begin + SaveDialog1.Filter := 'LazStats matrix files (*.mat)|*.mat;*.MAT|All files (*.*)|*.*'; + SaveDialog1.FilterIndex := 1; + if SaveDialog1.Execute then + begin + filename := SaveDialog1.FileName; + MatSave(Corrs, NoVars, NoVars, Means, StdDevs, NCases, IndRowLabels, IndColLabels, filename); + end; + end; + + DisplayReport(lReport); + + finally + lReport.Free; + ColEntered := nil; + BetaWeights := nil; + IndColLabels := nil; + IndRowLabels := nil; + StdDevs := nil; + Variances := nil; + Means := nil; + IndepInverse := nil; + corrs := nil; + IndepVarsCols := nil; + end; +end; + +procedure TLSMregForm.DepInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepVar.Text = '') then + begin + DepVar.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TLSMregForm.DepOutBtnClick(Sender: TObject); +begin + if DepVar.Text <> '' then + begin + VarList.Items.Add(DepVar.Text); + DepVar.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TLSMregForm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + IndepVars.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TLSMregForm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < IndepVars.Items.Count do + begin + if IndepVars.Selected[i] then + begin + VarList.Items.Add(IndepVars.Items[i]); + IndepVars.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TLSMregForm.UpdateBtnStates; +var + i: Integer; + lSelected: Boolean; +begin + lSelected := false; + for i := 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + DepInBtn.Enabled := lSelected; + InBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to IndepVars.Items.Count-1 do + if IndepVars.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; + DepOutBtn.Enabled := DepVar.Text <> ''; + AllBtn.Enabled := VarList.Items.Count > 0; +end; + +procedure TLSMregForm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I lsmrunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/simultregunit.lfm b/applications/lazstats/source/forms/analysis/multiple_regression/simultregunit.lfm new file mode 100644 index 000000000..c72c2c228 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/simultregunit.lfm @@ -0,0 +1,285 @@ +object SimultFrm: TSimultFrm + Left = 872 + Height = 447 + Top = 291 + Width = 437 + AutoSize = True + Caption = 'Simultaneous Multiple Regression' + ClientHeight = 447 + ClientWidth = 437 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ListBox1 + AnchorSideTop.Control = Owner + Left = 249 + Height = 15 + Top = 8 + Width = 127 + BorderSpacing.Top = 8 + Caption = 'Variables to be Analyzed' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 234 + Top = 25 + Width = 179 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 204 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 204 + Height = 28 + Top = 65 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 195 + Height = 25 + Top = 112 + Width = 46 + AutoSize = True + Caption = 'ALL' + OnClick = AllBtnClick + TabOrder = 3 + end + object ListBox1: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 249 + Height = 235 + Top = 24 + Width = 180 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 4 + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 123 + Top = 267 + Width = 417 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.HorizontalSpacing = 16 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 103 + ClientWidth = 413 + TabOrder = 5 + object MatInChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 0 + Width = 175 + Caption = 'Get Data From a Matrix File' + TabOrder = 0 + end + object MatSaveChkBox: TCheckBox + Left = 203 + Height = 19 + Top = 0 + Width = 198 + Caption = 'Save Correlation Matrix' + TabOrder = 1 + end + object CPChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 21 + Width = 175 + Caption = 'Show Cross-Products Matrix' + TabOrder = 2 + end + object CovChkBox: TCheckBox + Left = 203 + Height = 19 + Top = 21 + Width = 198 + Caption = 'Show Variance-Covariance Matrix' + TabOrder = 3 + end + object CorrsChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 42 + Width = 175 + Caption = 'Show Intercorrelations Matrix' + TabOrder = 4 + end + object MeansChkBox: TCheckBox + Left = 203 + Height = 19 + Top = 42 + Width = 198 + Caption = 'Show Means' + TabOrder = 5 + end + object VarChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 63 + Width = 175 + Caption = 'Show Variances' + TabOrder = 6 + end + object SDChkBox: TCheckBox + Left = 203 + Height = 19 + Top = 63 + Width = 198 + Caption = 'Show Standard Deviations' + TabOrder = 7 + end + object InvMatChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 84 + Width = 175 + Caption = 'Show Inverse Matrix' + TabOrder = 8 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 228 + Height = 25 + Top = 414 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 6 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 290 + Height = 25 + Top = 414 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 7 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 374 + Height = 25 + Top = 414 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 8 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 398 + Width = 437 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object OpenDialog1: TOpenDialog + left = 88 + top = 96 + end + object SaveDialog1: TSaveDialog + left = 88 + top = 160 + end +end diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/simultregunit.pas b/applications/lazstats/source/forms/analysis/multiple_regression/simultregunit.pas new file mode 100644 index 000000000..de0da656e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/simultregunit.pas @@ -0,0 +1,459 @@ +// Use file "cansas.laz" for testing, all variables. + +unit SimultRegUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + Globals, MainUnit, MatrixLib, OutputUnit, FunctionsLib, DataProcs; + +type + + { TSimultFrm } + + TSimultFrm = class(TForm) + Bevel1: TBevel; + OpenDialog1: TOpenDialog; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + MatInChkBox: TCheckBox; + MatSaveChkBox: TCheckBox; + CPChkBox: TCheckBox; + CovChkBox: TCheckBox; + CorrsChkBox: TCheckBox; + MeansChkBox: TCheckBox; + SaveDialog1: TSaveDialog; + VarChkBox: TCheckBox; + SDChkBox: TCheckBox; + InvMatChkBox: TCheckBox; + GroupBox1: TGroupBox; + InBtn: TBitBtn; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + Label1: TLabel; + Label2: TLabel; + ListBox1: TListBox; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + SimultFrm: TSimultFrm; + +implementation + +uses + Math; + +{ TSimultFrm } + +procedure TSimultFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + ListBox1.Clear; + for i := 1 to NoVariables do + begin + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + end; + InBtn.Enabled := true; + OutBtn.Enabled := false; + CPChkBox.Checked := false; + CovChkBox.Checked := false; + CorrsChkBox.Checked := true; + MeansChkBox.Checked := true; + VarChkBox.Checked := false; + SDChkBox.Checked := true; + MatInChkBox.Checked := false; + MatSaveChkBox.Checked := false; +end; + +procedure TSimultFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TSimultFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TSimultFrm.AllBtnClick(Sender: TObject); +var + index: integer; +begin + for index := 0 to VarList.Items.Count-1 do + ListBox1.Items.Add(VarList.Items[index]); + VarList.Clear; + UpdateBtnStates; +end; + +procedure TSimultFrm.ComputeBtnClick(Sender: TObject); +var + NoVars, i, j, NCases, errcode: integer; + StdErr, df1, df2, x, determinant : double; + errorcode : boolean = false; + filename : string; + cellstring, outline, valstring : string; + Corrs : DblDyneMat; + Means : DblDyneVec; + Variances : DblDyneVec; + StdDevs : DblDyneVec; + ColNoSelected : IntDyneVec; + title : string; + RowLabels : StrDyneVec; + ColLabels : StrDyneVec; + InverseMat : DblDyneMat; + R2s : DblDyneVec; + W : DblDyneVec; + ProdMat : DblDyneMat; + FProbs : DblDyneVec; + CorrMat : DblDyneMat; + lReport: TStrings; + +begin + SetLength(Corrs,NoVariables+1,NoVariables+1); + SetLength(Means,NoVariables); + SetLength(Variances,NoVariables); + SetLength(StdDevs,NoVariables); + SetLength(RowLabels,NoVariables); + SetLength(ColLabels,NoVariables); + SetLength(InverseMat,NoVariables,NoVariables); + SetLength(R2s,NoVariables); + SetLength(W,NoVariables); + SetLength(ProdMat,NoVariables+1,NoVariables+1); + SetLength(Fprobs,NoVariables); + SetLength(CorrMat,NoVariables+1,NoVariables+1); + SetLength(ColNoSelected,NoVariables); + + lReport := TStringList.Create; + try + lReport.Add('SIMULTANEOUS MULTIPLE REGRESSION by Bill Miller'); + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + errcode := 0; + if MatInChkBox.Checked then + begin + OpenDialog1.Filter := 'FreeStat matrix files (*.mat)|*.mat;*.MAT|All files (*.*)|*.*'; + OpenDialog1.FilterIndex := 1; + if OpenDialog1.Execute then + begin + filename := OpenDialog1.FileName; + MATREAD(Corrs,NoVars,NoVars,Means,StdDevs,NCases,RowLabels,ColLabels,filename); + for i := 1 to NoVars do Variances[i-1] := sqr(StdDevs[i-1]); + MessageDlg('Last variable in matrix is the dependent variable', mtInformation, [mbOK], 0); + end; + end else + begin + { get variable columns } + NoVars := ListBox1.Items.Count; + if NoVars < 1 then + begin + MessageDlg('No variables selected.',mtError, [mbOK], 0); + exit; + end; + for i := 1 to NoVars do + begin + cellstring := ListBox1.Items.Strings[i-1]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[i-1] := j; + RowLabels[i-1] := cellstring; + ColLabels[i-1] := cellstring; + end; + end; + end; + end; + + if CPChkBox.Checked then + begin + title := 'Cross-Products Matrix'; + GridXProd(NoVars,ColNoSelected,Corrs,errorcode,NCases); + MatPrint(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport); + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + end; + + if CovChkBox.Checked then + begin + title := 'Variance-Covariance Matrix'; + GridCovar(NoVars,ColNoSelected,Corrs,Means,Variances, + StdDevs,errorcode,NCases); + MatPrint(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport); + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + end; + + Correlations(NoVars,ColNoSelected,Corrs,Means,Variances, StdDevs,errorcode,NCases); + + if CorrsChkBox.Checked = true then + begin + for i := 1 to NoVars do + for j := 1 to NoVars do InverseMat[i-1,j-1] := Corrs[i-1,j-1]; + title := 'Product-Moment Correlations Matrix'; + MatPrint(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport); + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + end; + + if MatSaveChkBox.Checked then + begin + SaveDialog1.Filter := 'OpenStat matrix files (*.mat)|*.mat;*.MAT|All files (*.*)|*.*'; + SaveDialog1.FilterIndex := 1; + if SaveDialog1.Execute then + begin + filename := SaveDialog1.FileName; + MATSAVE(Corrs,NoVars,NoVars,Means,StdDevs,NCases,RowLabels,ColLabels,filename); + end; + end; + + title := 'Means'; + if MeansChkBox.Checked = true then + begin + title := 'Means'; + DynVectorPrint(Means,NoVars,title,ColLabels,NCases, lReport); + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + end; + + if VarChkBox.Checked then + begin + title := 'Variances'; + DynVectorPrint(Variances,NoVars,title,ColLabels,NCases, lReport); + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + end; + + if SDChkBox.Checked then + begin + title := 'Standard Deviations'; + DynVectorPrint(StdDevs,NoVars,title,ColLabels,NCases, lReport); + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + end; + + if errcode > 0 then + begin + lReport.Add('One or more correlations could not be computed due to zero variance of a variable.'); + MessageDlg('A selected variable has no variability-run aborted.', mtError, [mbOK], 0); + exit; + end; + + determinant := 0.0; + for i := 1 to NoVars do + for j := 1 to NoVars do + CorrMat[i-1,j-1] := Corrs[i-1,j-1]; + Determ(CorrMat,NoVars,NoVars,determinant,errorcode); + if (determinant < 0.000001) then + begin + MessageDlg('Matrix is singular.', mtError, [mbOK], 0); + exit; + end; + lReport.Add('Determinant of correlation matrix = %8.4f', [Determinant]); + lReport.Add(''); + + SVDinverse(InverseMat, NoVars); + if InvMatChkBox.Checked then + begin + title := 'Inverse of correlation matrix'; + MatPrint(InverseMat,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport); + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + end; + + lReport.Add('Multiple Correlation Coefficients for Each Variable'); + lReport.Add(''); + lReport.Add('%10s%8s%10s%10s%12s%5s%5s', ['Variable','R','R2','F','Prob.>F','DF1','DF2']); + + df1 := NoVars - 1.0; + df2 := NCases - NoVars; + + for i := 1 to NoVars do + begin // R squared values + R2s[i-1] := 1.0 - (1.0 / InverseMat[i-1,i-1]); + W[i-1] := (R2s[i-1] / df1) / ((1.0-R2s[i-1]) / df2); + FProbs[i-1] := probf(W[i-1],df1,df2); + valstring := format('%10s',[ColLabels[i-1]]); + lReport.Add('%10s%10.3f%10.3f%10.3f%10.3f%5.0f%5.0f', [ + valstring,sqrt(R2s[i-1]),R2s[i-1],W[i-1],FProbs[i-1],df1,df2 + ]); + for j := 1 to NoVars do + begin // betas + ProdMat[i-1,j-1] := -InverseMat[i-1,j-1] / InverseMat[j-1,j-1]; + end; + end; + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + + title := 'Betas in Columns'; + MatPrint(ProdMat,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport); + lReport.Add('Standard Errors of Prediction'); + lReport. Add('Variable Std.Error'); + for i := 1 to NoVars do + begin + StdErr := (NCases-1) * Variances[i-1] * (1.0 / InverseMat[i-1,i-1]); + StdErr := sqrt(StdErr / (NCases - NoVars)); + valstring := format('%10s', [ColLabels[i-1]]); + lReport.Add('%10s%10.3f', [valstring,StdErr]); + end; + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + + for i := 1 to NoVars do + for j := 1 to NoVars do + if (i <> j) then ProdMat[i-1,j-1] := ProdMat[i-1,j-1] * (StdDevs[j-1]/StdDevs[i-1]); + title := 'Raw Regression Coefficients'; + MatPrint(ProdMat,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport); + lReport.Add('Variable Constant'); + for i := 1 to NoVars do + begin + x := 0.0; + for j := 1 to NoVars do + begin + if (i <> j) then x := x + (ProdMat[j-1,i-1] * Means[j-1]); + end; + x := Means[i-1] - x; + valstring := format('%10s',[ColLabels[i-1]]); + lReport.Add('%10s%10.3f', [valstring, x]); + end; + lReport.Add('------------------------------------------------------------------'); + lReport.Add(''); + + // Get partial correlation matrix + for i := 1 to NoVars do + begin + for j := 1 to NoVars do + begin + ProdMat[i-1,j-1] := -(1.0 / sqrt(InverseMat[i-1,i-1])) * + InverseMat[i-1,j-1] * (1.0 / sqrt(InverseMat[j-1,j-1])); + end; + end; + title := 'Partial Correlations'; + MatPrint(ProdMat,NoVars,NoVars,title,RowLabels,ColLabels,NCases, lReport); + + finally + if lReport.Count > 0 then + DisplayReport(lReport); + + ColNoSelected := nil; + CorrMat := nil; + Fprobs := nil; + ProdMat := nil; + W := nil; + R2s := nil; + InverseMat := nil; + ColLabels := nil; + RowLabels := nil; + StdDevs := nil; + Variances := nil; + Means := nil; + corrs := nil; + end; +end; + +procedure TSimultFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; +end; + +procedure TSimultFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TSimultFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + ListBox1.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end + else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TSimultFrm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < Listbox1.Items.Count do + begin + if Listbox1.Selected[i] then + begin + VarList.Items.Add(Listbox1.Items[i]); + Listbox1.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TSimultFrm.UpdateBtnStates; +var + i: Integer; + lSelected: Boolean; +begin + lSelected := false; + for i := 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + InBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to ListBox1.Items.Count-1 do + if ListBox1.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; + + AllBtn.Enabled := VarList.Items.Count > 0; +end; + +initialization + {$I simultregunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/stepfwdmrunit.lfm b/applications/lazstats/source/forms/analysis/multiple_regression/stepfwdmrunit.lfm new file mode 100644 index 000000000..2119e4b81 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/stepfwdmrunit.lfm @@ -0,0 +1,446 @@ +object StepFwdFrm: TStepFwdFrm + Left = 677 + Height = 461 + Top = 239 + Width = 469 + AutoSize = True + Caption = 'Forward Stepwise Multiple Regression' + ClientHeight = 461 + ClientWidth = 469 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ListBox1 + AnchorSideTop.Control = Owner + Left = 189 + Height = 15 + Top = 8 + Width = 127 + BorderSpacing.Top = 8 + Caption = 'Variables to be Analyzed' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = DepVar + AnchorSideTop.Control = Owner + Left = 346 + Height = 15 + Top = 8 + Width = 102 + BorderSpacing.Top = 8 + Caption = 'Dependent Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 244 + Top = 25 + Width = 119 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 144 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 144 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = OutBtn + AnchorSideTop.Side = asrBottom + Left = 135 + Height = 25 + Top = 97 + Width = 46 + Anchors = [akTop] + AutoSize = True + BorderSpacing.Top = 12 + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 3 + end + object ListBox1: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepInBtn + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 189 + Height = 244 + Top = 25 + Width = 113 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 4 + end + object DepInBtn: TBitBtn + Left = 310 + Height = 28 + Top = 24 + Width = 28 + Anchors = [akTop] + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInBtnClick + Spacing = 0 + TabOrder = 5 + end + object DepOutBtn: TBitBtn + AnchorSideLeft.Control = DepInBtn + AnchorSideTop.Control = DepInBtn + AnchorSideTop.Side = asrBottom + Left = 310 + Height = 28 + Top = 52 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutBtnClick + Spacing = 0 + TabOrder = 6 + end + object DepVar: TEdit + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 346 + Height = 23 + Top = 25 + Width = 115 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 7 + Text = 'DepVar' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 135 + Top = 277 + Width = 451 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 16 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 18 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 5 + ClientHeight = 115 + ClientWidth = 447 + TabOrder = 9 + object CPChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 6 + Width = 196 + Caption = 'Show Cross-Products Matrix' + TabOrder = 0 + end + object CovChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 27 + Width = 196 + Caption = 'Show Variance-covariance Matrix' + TabOrder = 1 + end + object CorrsChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 48 + Width = 196 + Caption = 'Show Intercorrelations Matrix' + TabOrder = 2 + end + object MeansChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 69 + Width = 196 + Caption = 'Show Means' + TabOrder = 3 + end + object VarChkBox: TCheckBox + Left = 16 + Height = 19 + Top = 90 + Width = 196 + Caption = 'Show Variances' + TabOrder = 4 + end + object SDChkBox: TCheckBox + Left = 230 + Height = 19 + Top = 6 + Width = 201 + Caption = 'Show Standard Deviations' + TabOrder = 5 + end + object MatInChkBox: TCheckBox + Left = 230 + Height = 19 + Top = 27 + Width = 201 + Caption = 'Get Data from a Matrix File' + TabOrder = 6 + end + object MatSaveChkBox: TCheckBox + Left = 230 + Height = 19 + Top = 48 + Width = 201 + Caption = 'Save the Correlation Matrix' + TabOrder = 7 + end + object PredictChkBox: TCheckBox + Left = 230 + Height = 19 + Top = 69 + Width = 201 + Caption = 'Predictions, residuals, C.I.''s to Grid' + TabOrder = 8 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 168 + Height = 25 + Top = 428 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 10 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 308 + Height = 25 + Top = 428 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 11 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 234 + Height = 25 + Top = 428 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 12 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 396 + Height = 25 + Top = 428 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 13 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 412 + Width = 469 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = DepInBtn + AnchorSideTop.Control = DepOutBtn + AnchorSideTop.Side = asrBottom + Left = 310 + Height = 80 + Top = 92 + Width = 132 + AutoSize = True + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + Caption = 'Minimum Probability' + ClientHeight = 60 + ClientWidth = 128 + TabOrder = 8 + object Label4: TLabel + AnchorSideTop.Control = InProb + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = InProb + Left = 25 + Height = 15 + Top = 6 + Width = 44 + Anchors = [akTop, akRight] + BorderSpacing.Left = 18 + BorderSpacing.Right = 8 + Caption = 'to Enter:' + ParentColor = False + end + object Label5: TLabel + AnchorSideTop.Control = ProbOut + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ProbOut + Left = 19 + Height = 15 + Top = 33 + Width = 50 + Anchors = [akTop, akRight] + BorderSpacing.Left = 18 + BorderSpacing.Right = 8 + Caption = 'to Retain:' + ParentColor = False + end + object InProb: TEdit + AnchorSideTop.Control = GroupBox2 + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 77 + Height = 23 + Top = 2 + Width = 39 + Anchors = [akTop, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 12 + TabOrder = 0 + Text = 'InProb' + end + object ProbOut: TEdit + AnchorSideLeft.Control = InProb + AnchorSideTop.Control = InProb + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 77 + Height = 23 + Top = 29 + Width = 39 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + TabOrder = 1 + Text = 'Edit1' + end + end + object Bevel2: TBevel + Left = 5 + Height = 15 + Top = 352 + Width = 13 + Shape = bsSpacer + end + object OpenDialog1: TOpenDialog + left = 49 + top = 48 + end + object SaveDialog1: TSaveDialog + left = 48 + top = 112 + end +end diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/stepfwdmrunit.pas b/applications/lazstats/source/forms/analysis/multiple_regression/stepfwdmrunit.pas new file mode 100644 index 000000000..839a67daf --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/stepfwdmrunit.pas @@ -0,0 +1,500 @@ +unit StepFwdMRUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + Globals, MainUnit, MatrixLib, OutputUnit, FunctionsLib, DataProcs; + +type + + { TStepFwdFrm } + + TStepFwdFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + GroupBox2: TGroupBox; + OpenDialog1: TOpenDialog; + ResetBtn: TButton; + ComputeBtn: TButton; + CancelBtn: TButton; + ReturnBtn: TButton; + PredictChkBox: TCheckBox; + MatSaveChkBox: TCheckBox; + MatInChkBox: TCheckBox; + SaveDialog1: TSaveDialog; + SDChkBox: TCheckBox; + VarChkBox: TCheckBox; + MeansChkBox: TCheckBox; + CorrsChkBox: TCheckBox; + CovChkBox: TCheckBox; + CPChkBox: TCheckBox; + GroupBox1: TGroupBox; + InProb: TEdit; + ProbOut: TEdit; + InBtn: TBitBtn; + Label4: TLabel; + Label5: TLabel; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + DepInBtn: TBitBtn; + DepOutBtn: TBitBtn; + DepVar: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + ListBox1: TListBox; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure DepInBtnClick(Sender: TObject); + procedure DepOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: boolean; + public + { public declarations } + end; + +var + StepFwdFrm: TStepFwdFrm; + +implementation + +uses + Math; + +{ TStepFwdFrm } + +procedure TStepFwdFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + ListBox1.Clear; + for i := 1 to NoVariables do + begin + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + end; + InBtn.Enabled := true; + OutBtn.Enabled := false; + DepInBtn.Enabled := true; + DepOutBtn.Enabled := false; + DepVar.Text := ''; + InProb.Text := '0.05'; + ProbOut.Text := '0.10'; + CPChkBox.Checked := false; + CovChkBox.Checked := false; + CorrsChkBox.Checked := true; + MeansChkBox.Checked := true; + VarChkBox.Checked := false; + SDChkBox.Checked := true; + MatInChkBox.Checked := false; + MatSaveChkBox.Checked := false; + PredictChkBox.Checked := false; +end; + +procedure TStepFwdFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinHeight := Max(200, GroupBox2.Top + Groupbox2.Height - VarList.Top); + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TStepFwdFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TStepFwdFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TStepFwdFrm.AllBtnClick(Sender: TObject); +var count, index : integer; +begin + count := VarList.Items.Count; + for index := 0 to count-1 do + begin + ListBox1.Items.Add(VarList.Items.Strings[index]); + end; + VarList.Clear; +end; + +procedure TStepFwdFrm.ComputeBtnClick(Sender: TObject); +Label CleanUp, lastone; +var + i, j, k, k1, NoVars, NCases,errcnt : integer; + errorcode : boolean; + Index, NoIndepVars : integer; + largest, R2, Constant: double; + StdErrEst, NewR2, LargestPartial : double; + pdf1, pdf2, PartF, PartProb, LargestProb, POut : double; + SmallestProb : double; + BetaWeights : DblDyneVec; + cellstring, outline: string; + corrs : DblDyneMat; + Means : DblDyneVec; + Variances : DblDyneVec; + StdDevs : DblDyneVec; + ColNoSelected : IntDyneVec; + title : string; + RowLabels : StrDyneVec; + ColLabels : StrDyneVec; + IndRowLabels : StrDyneVec; + IndColLabels : StrDyneVec; + IndepCorrs : DblDyneMat; + IndepInverse : DblDyneMat; + IndepIndex : IntDyneVec; + XYCorrs : DblDyneVec; + matched : boolean; + Partial : DblDyneVec; + Candidate : IntDyneVec; + TempNoVars : Integer; + StepNo : integer; + filename : string; +begin + if NoVariables = 0 then NoVariables := 200; + SetLength(corrs,NoVariables+1,NoVariables+1); + SetLength(IndepCorrs,NoVariables,NoVariables); + SetLength(IndepInverse,NoVariables,NoVariables); + SetLength(Means,NoVariables); + SetLength(Variances,NoVariables); + SetLength(StdDevs,NoVariables); + SetLength(RowLabels,NoVariables); + SetLength(ColLabels,NoVariables); + SetLength(XYCorrs,NoVariables); + SetLength(IndepIndex,NoVariables); + SetLength(IndColLabels,NoVariables); + SetLength(IndRowLabels,NoVariables); + SetLength(BetaWeights,NoVariables); + SetLength(Partial,NoVariables); + SetLength(Candidate,NoVariables); + SetLength(ColNoSelected,NoVariables); + + OutputFrm.RichEdit.Clear; +// OutputFrm.RichEdit.ParaGraph.Alignment := taLeftJustify; + OutputFrm.RichEdit.Lines.Add('Stepwise Multiple Regression by Bill Miller'); + StepNo := 1; + errcnt := 0; + errorcode := false; + if MatInChkBox.Checked = true then + begin + OpenDialog1.Filter := 'OS3 matrix files (*.MAT)|*.MAT|All files (*.*)|*.*'; + OpenDialog1.FilterIndex := 1; + if OpenDialog1.Execute then + begin + filename := OpenDialog1.FileName; + MATREAD(Corrs,NoVars,NoVars,Means,StdDevs,NCases,RowLabels,ColLabels,filename); + for i := 0 to NoVars-1 do + begin + Variances[i] := sqr(StdDevs[i]); + ColNoSelected[i] := i+1; + end; + DepVar.Text := RowLabels[NoVars-1]; + for i := 0 to NoVars-2 do ListBox1.Items.Add(RowLabels[i]); + ShowMessage('NOTICE! Last variable in matrix is the dependent variable'); + end; + end; + if MatInChkBox.Checked = false then + begin + { get independent item columns } + NoVars := ListBox1.Items.Count; + if NoVars < 1 then + begin + ShowMessage('ERROR! No independent variables selected.'); + goto CleanUp; + end; + for i := 0 to NoVars-1 do + begin + cellstring := ListBox1.Items.Strings[i]; + for j := 1 to NoVariables do + begin + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[i] := j; + RowLabels[i] := cellstring; + ColLabels[i] := cellstring; + end; + end; + end; + { get dependendent variable column } + if DepVar.Text = '' then + begin + ShowMessage('ERROR! No Dependent variable selected.'); + goto CleanUp; + end; + NoVars := NoVars + 1; + for j := 1 to NoVariables do + begin + if DepVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then + begin + ColNoSelected[NoVars-1] := j; + RowLabels[NoVars-1] := DepVar.Text; + ColLabels[NoVars-1] := DepVar.Text; + end; + end; + if CPChkBox.Checked = true then + begin + title := 'Cross-Products Matrix'; + GridXProd(NoVars,ColNoSelected,Corrs,errorcode,NCases); + MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases); + end; + if CovChkBox.Checked = true then + begin + title := 'Variance-Covariance Matrix'; + GridCovar(NoVars,ColNoSelected,Corrs,Means,Variances, + StdDevs,errorcode,NCases); + MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases); + end; + Correlations(NoVars,ColNoSelected,Corrs,Means,Variances, + StdDevs,errorcode,NCases); + end; + if CorrsChkBox.Checked = true then + begin + title := 'Product-Moment Correlations Matrix'; + MAT_PRINT(Corrs,NoVars,NoVars,title,RowLabels,ColLabels,NCases); + end; + if MatSaveChkBox.Checked = true then + begin + SaveDialog1.Filter := 'OS3 matrix files (*.MAT)|*.MAT|All files (*.*)|*.*'; + SaveDialog1.FilterIndex := 1; + if SaveDialog1.Execute then + begin + filename := SaveDialog1.FileName; + MATSAVE(Corrs,NoVars,NoVars,Means,StdDevs,NCases,RowLabels,ColLabels,filename); + end; + end; + title := 'Means'; + if MeansChkBox.Checked = true then + DynVectorPrint(Means,NoVars,title,ColLabels,NCases); + title := 'Variances'; + if VarChkBox.Checked = true then + DynVectorPrint(Variances,NoVars,title,ColLabels,NCases); + title := 'Standard Deviations'; + if SDChkBox.Checked = true then + DynVectorPrint(StdDevs,NoVars,title,ColLabels,NCases); + if errorcode then + begin + OutputFrm.RichEdit.Lines.Add('One or more correlations could not be computed due to zero variance of a variable.'); + end; + OutputFrm.ShowModal; + if errorcode then + begin + ShowMessage('ERROR! A selected variable has no variability-run aborted.'); + goto CleanUp; + end; + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Stepwise Multiple Regression by Bill Miller'); + + { Select largest correlation to begin. Note: dependent is last variable } + largest := 0.0; + Index := 1; + for i := 1 to NoVars - 1 do + begin + if abs(corrs[i-1,NoVars-1]) > largest then + begin + largest := abs(corrs[i-1,NoVars-1]); + Index := i; + end; + end; + NoIndepVars := 1; + IndepIndex[NoIndepVars-1] := Index; + POut := StrToFloat(ProbOut.Text); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('----------------- STEP %d ------------------',[StepNo]); + OutputFrm.RichEdit.Lines.Add(outline); + MReg2(NCases,NoVars,NoIndepVars,IndepIndex,corrs,IndepInverse, + RowLabels,R2,BetaWeights, + Means,Variances,errcnt,StdErrEst,constant,POut,true, true,false, OutputFrm.RichEdit.Lines); + OutputFrm.ShowModal; + while NoIndepVars < NoVars-1 do + begin + { select the next independent variable based on the largest + semipartial correlation with the dependent variable. The + squared semipartial for each remaining independent variable + is the difference between the squared MC of the dependent + variable with all previously entered variables plus a candidate + variable and the squared MC with just the previously entered + variables ( the previously obtained R2 ). } + { build list of candidates } + StepNo := StepNo + 1; + k := 0; + for i := 1 to NoVars - 1 do + begin + matched := false; + for j := 0 to NoIndepVars-1 do + begin + if IndepIndex[j] = i then matched := true; + end; + if (matched = false) then + begin + k := k + 1; + Candidate[k-1] := i; + end; + end; { k is the no. of candidates } + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Candidates for entry in next step.'); + OutputFrm.RichEdit.Lines.Add('Candidate Partial F Statistic Prob. DF1 DF2'); + LargestProb := 0.0; + SmallestProb := 1.0; + for k1 := 1 to k do + begin + { get Mult Corr. with previously entered plus candidate } + IndepIndex[NoIndepVars] := Candidate[k1-1]; + TempNoVars := NoIndepVars + 1; + MReg2(NCases,NoVars,TempNoVars,IndepIndex,corrs,IndepInverse, + RowLabels,NewR2,BetaWeights, Means,Variances, + errcnt, StdErrEst, constant, POut, false, false,false, OutputFrm.RichEdit.Lines); + Partial[k1-1] := (NewR2 - R2) / (1.0 - R2); + pdf1 := 1; + pdf2 := NCases - TempNoVars - 1; + PartF := ((NewR2 - R2) * pdf2) / (1.0 - NewR2); + PartProb := probf(PartF,pdf1,pdf2); + if PartProb < SmallestProb then SmallestProb := PartProb; + if PartProb > LargestProb then LargestProb := PartProb; + outline := format('%-10s %6.4f %7.4f %6.4f %3.0f %3.0f', + [RowLabels[Candidate[k1-1]-1], sqrt(abs(Partial[k1-1])), PartF, PartProb, pdf1, pdf2]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + + if (SmallestProb > StrToFloat(InProb.Text)) then + begin + OutputFrm.RichEdit.Lines.Add('No further steps meet criterion for entry.'); + goto lastone; + end; + { select variable with largest partial to enter next } + largestpartial := 0.0; + Index := 1; + for i := 1 to k do + begin + if Partial[i-1] > LargestPartial then + begin + Index := Candidate[i-1]; + LargestPartial := Partial[i-1]; + end; + end; + + outline := format('Variable %s will be added',[RowLabels[Index-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + NoIndepVars := NoIndepVars + 1; + IndepIndex[NoIndepVars-1] := Index; + OutputFrm.RichEdit.Lines.Add(''); + outline := format('----------------- STEP %d ------------------',[StepNo]); + OutputFrm.RichEdit.Lines.Add(outline); + MReg2(NCases,NoVars,NoIndepVars,IndepIndex,corrs,IndepInverse, + RowLabels,R2,BetaWeights, Means,Variances, + errcnt, StdErrEst, constant,POut,true,true,false, OutputFrm.RichEdit.Lines); + if (errcnt > 0) or (NoIndepVars = NoVars-1) then { out tolerance exceeded - finish up } +lastone: begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('-------------FINAL STEP-----------'); + MReg2(NCases,NoVars,NoIndepVars,IndepIndex,corrs,IndepInverse, + RowLabels,NewR2,BetaWeights,Means,Variances, + errcnt,StdErrEst,constant,POut,true,false,false, OutputFrm.RichEdit.Lines); + k1 := NoIndepVars; { store temporarily } + NoIndepVars := NoVars; { this stops loop } + end; + end; { while not done } + OutputFrm.ShowModal; + + NoIndepVars := k1; + { add [predicted scores, residual scores, etc. to grid if options elected } + if MatInChkBox.Checked = true then PredictChkBox.Checked := false; + if PredictChkBox.Checked = true then + Predict(ColNoSelected, NoVars, IndepInverse, Means, StdDevs, + BetaWeights, StdErrEst, IndepIndex, NoIndepVars); + +CleanUp: + ColNoSelected := nil; + Candidate := nil; + Partial := nil; + BetaWeights := nil; + IndColLabels := nil; + IndRowLabels := nil; + IndepIndex := nil; + XYCorrs := nil; + ColLabels := nil; + RowLabels := nil; + StdDevs := nil; + Variances := nil; + Means := nil; + IndepInverse := nil; + IndepCorrs := nil; + corrs := nil; +end; + +procedure TStepFwdFrm.DepInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := ListBox1.ItemIndex; + DepVar.Text := ListBox1.Items.Strings[index]; + ListBox1.Items.Delete(index); + DepOutBtn.Enabled := true; + DepInBtn.Enabled := false; +end; + +procedure TStepFwdFrm.DepOutBtnClick(Sender: TObject); +begin + ListBox1.Items.Add(DepVar.Text); + DepVar.Text := ''; + DepInBtn.Enabled := true; +end; + +procedure TStepFwdFrm.InBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + ListBox1.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + OutBtn.Enabled := true; +end; + +procedure TStepFwdFrm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := ListBox1.ItemIndex; + VarList.Items.Add(ListBox1.Items.Strings[index]); + ListBox1.Items.Delete(index); + InBtn.Enabled := true; +end; + +initialization + {$I stepfwdmrunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/twoslsunit.lfm b/applications/lazstats/source/forms/analysis/multiple_regression/twoslsunit.lfm new file mode 100644 index 000000000..f41cb2200 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/twoslsunit.lfm @@ -0,0 +1,387 @@ +object TwoSLSFrm: TTwoSLSFrm + Left = 582 + Height = 416 + Top = 203 + Width = 415 + AutoSize = True + Caption = 'Two Stage Least Squares Regression' + ClientHeight = 416 + ClientWidth = 415 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 46 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = DepVarEdit + AnchorSideTop.Control = DepIn + AnchorSideBottom.Control = DepVarEdit + Left = 229 + Height = 15 + Top = 25 + Width = 102 + Caption = 'Dependent Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Explanatory + AnchorSideTop.Control = ExpIn + Left = 229 + Height = 15 + Top = 101 + Width = 111 + Caption = 'Explanatory Variables' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = Instrumental + AnchorSideTop.Control = Bevel2 + AnchorSideTop.Side = asrCenter + Left = 229 + Height = 15 + Top = 182 + Width = 116 + Caption = 'Instrumental Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepIn + AnchorSideBottom.Control = GroupBox1 + Left = 8 + Height = 253 + Top = 25 + Width = 177 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object DepIn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 193 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInClick + Spacing = 0 + TabOrder = 1 + end + object DepOut: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepIn + AnchorSideTop.Side = asrBottom + Left = 193 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutClick + Spacing = 0 + TabOrder = 2 + end + object ExpIn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepOut + AnchorSideTop.Side = asrBottom + Left = 193 + Height = 28 + Top = 101 + Width = 28 + BorderSpacing.Top = 16 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ExpInClick + Spacing = 0 + TabOrder = 4 + end + object ExpOut: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ExpIn + AnchorSideTop.Side = asrBottom + Left = 193 + Height = 28 + Top = 133 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ExpOutClick + Spacing = 0 + TabOrder = 5 + end + object InstIn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Label4 + AnchorSideBottom.Control = InstOut + Left = 193 + Height = 28 + Top = 182 + Width = 28 + BorderSpacing.Bottom = 4 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InstInClick + Spacing = 0 + TabOrder = 7 + end + object InstOut: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InstIn + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 193 + Height = 28 + Top = 214 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + Spacing = 0 + TabOrder = 8 + end + object DepVarEdit: TEdit + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOut + AnchorSideBottom.Side = asrBottom + Left = 229 + Height = 23 + Top = 42 + Width = 178 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 3 + Text = 'DepVarEdit' + end + object Explanatory: TListBox + AnchorSideLeft.Control = ExpIn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Label4 + Left = 229 + Height = 40 + Top = 118 + Width = 178 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 24 + ItemHeight = 0 + MultiSelect = True + TabOrder = 6 + end + object Instrumental: TListBox + AnchorSideLeft.Control = InstIn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 229 + Height = 79 + Top = 199 + Width = 178 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + TabOrder = 9 + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 73 + Top = 286 + Width = 308 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ClientHeight = 53 + ClientWidth = 304 + TabOrder = 10 + object ProxyRegShowChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 273 + Caption = 'Show Regression Results for each Proxy Variable' + TabOrder = 0 + end + object SaveItChk: TCheckBox + Left = 12 + Height = 19 + Top = 28 + Width = 280 + Caption = 'Save Predicted and Residuals of 2nd Stage to Grid' + TabOrder = 1 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 114 + Height = 25 + Top = 383 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 12 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 180 + Height = 25 + Top = 383 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 13 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 254 + Height = 25 + Top = 383 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 14 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 342 + Height = 25 + Top = 383 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 15 + end + object HelpBtn: TButton + Tag = 153 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 51 + Height = 25 + Top = 383 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 11 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 367 + Width = 415 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Bevel2: TBevel + AnchorSideLeft.Control = DepIn + AnchorSideTop.Control = ExpIn + AnchorSideRight.Control = DepIn + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 189 + Height = 177 + Top = 101 + Width = 4 + Anchors = [akTop, akRight, akBottom] + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/twoslsunit.pas b/applications/lazstats/source/forms/analysis/multiple_regression/twoslsunit.pas new file mode 100644 index 000000000..896693b0e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/twoslsunit.pas @@ -0,0 +1,527 @@ +unit TwoSLSUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, math, + Globals, MainUnit, MainDM, MatrixLib, DictionaryUnit, OutputUnit, ContextHelpUnit; + +type + + { TTwoSLSFrm } + + TTwoSLSFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + HelpBtn: TButton; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + ProxyRegShowChk: TCheckBox; + SaveItChk: TCheckBox; + DepIn: TBitBtn; + DepOut: TBitBtn; + ExpIn: TBitBtn; + ExpOut: TBitBtn; + GroupBox1: TGroupBox; + InstIn: TBitBtn; + InstOut: TBitBtn; + DepVarEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Explanatory: TListBox; + Instrumental: TListBox; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure DepInClick(Sender: TObject); + procedure DepOutClick(Sender: TObject); + procedure ExpInClick(Sender: TObject); + procedure ExpOutClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InstInClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure PredictIt(ColNoSelected : IntDyneVec; NoVars : integer; + Means, StdDevs, BetaWeights : DblDyneVec; + StdErrEst : double; NoIndepVars : integer); + + private + { private declarations } + FAutoSized: boolean; + + public + { public declarations } + end; + +var + TwoSLSFrm: TTwoSLSFrm; + +implementation + +{ TTwoSLSFrm } + +procedure TTwoSLSFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + Explanatory.Clear; + Instrumental.Clear; + DepVarEdit.Text := ''; + ProxyRegShowChk.Checked := false; + DepIn.Enabled := true; + DepOut.Enabled := false; + ExpIn.Enabled := true; + ExpOut.Enabled := false; + InstIn.Enabled := true; + InstOut.Enabled := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TTwoSLSFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := True; +end; + +procedure TTwoSLSFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); + if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TTwoSLSFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TTwoSLSFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TTwoSLSFrm.InstInClick(Sender: TObject); +VAR i : integer; +begin + if (VarList.Items.Count < 1) then exit; + i := 0; + while (i < VarList.Items.Count) do + begin + if (VarList.Selected[i]) then + begin + Instrumental.Items.Add(VarList.Items.Strings[i]); + end; + i := i + 1; + end; + InstOut.Enabled := true; + if (VarList.Items.Count < 1) then InstIn.Enabled := false; +end; + +procedure TTwoSLSFrm.DepInClick(Sender: TObject); +VAR index : integer; +begin + if (VarList.Items.Count < 1) then exit; + index := VarList.ItemIndex; + DepVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + DepOut.Enabled := true; + DepIn.Enabled := false; +end; + +procedure TTwoSLSFrm.ComputeBtnClick(Sender: TObject); +label cleanup; +VAR + i, j, k, DepCol, NoInst, NoExp, NoProx, Noindep : integer; + IndepCols, ProxSrcCols, ExpCols, InstCols, ProxCols : IntDyneVec; + DepProx, NCases, col, counter : integer; + ExpLabels, InstLabels, ProxLabels, RowLabels, ProxSrcLabels : StrDyneVec; + outstr : string; + R2, stderrest, X, Y : double; + Means, Variances, StdDevs, BWeights : DblDyneVec; + BetaWeights, BStdErrs, Bttests, tprobs : DblDyneVec; + ProxVals : DblDyneMat; + errorcode, PrintDesc, PrintCorrs, PrintInverse, PrintCoefs, SaveCorrs : boolean; + found : boolean; + +begin + if (ProxyRegShowChk.Checked) then + begin + PrintDesc := true; + PrintCorrs := true; + PrintInverse := false; + PrintCoefs := true; + SaveCorrs := false; + end + else + begin + PrintDesc := false; + PrintCorrs := false; + PrintInverse := false; + PrintCoefs := false; + SaveCorrs := false; + end; + SetLength(Means,NoVariables+2); + SetLength(Variances,NoVariables+2); + SetLength(StdDevs,NoVariables+2); + SetLength(BWeights,NoVariables+2); + SetLength(BetaWeights,NoVariables+2); + SetLength(BStdErrs,NoVariables+2); + SetLength(Bttests,NoVariables+2); + SetLength(tprobs,NoVariables+2); + SetLength(ExpLabels,NoVariables+2); + SetLength(ExpCols,NoVariables+2); + SetLength(InstLabels,NoVariables+2); + SetLength(InstCols,NoVariables+2); + SetLength(ProxCols,NoVariables); + SetLength(ProxLabels,NoVariables); + SetLength(IndepCols,NoVariables); + SetLength(RowLabels,NoVariables); + SetLength(ProxSrcCols,NoVariables); + SetLength(ProxSrcLabels,NoVariables); + SetLength(ProxVals,NoCases,NoVariables); + + // Get variables to analyze + NCases := NoCases; + NoInst := Instrumental.Items.Count; + NoExp := Explanatory.Items.Count; + if (NoInst < NoExp) then + begin + ShowMessage('The no. of Instrumental must equal or exceed the Explanatory'); + goto cleanup; + end; + for i := 0 to NoVariables - 1 do + begin + if (OS3MainFrm.DataGrid.Cells[i+1,0] = DepVarEdit.Text) then + begin + DepCol := i + 1; +// result := VarTypeChk(DepCol,0); +// if (result :=:= 1) goto cleanup; + end; + for j := 0 to NoExp - 1 do + begin + if (OS3MainFrm.DataGrid.Cells[i+1,0] = Explanatory.Items.Strings[j]) then + begin + ExpCols[j] := i+1; +// result := VarTypeChk(i+1,0); +// if (result :=:= 1) goto cleanup; + ExpLabels[j] := Explanatory.Items.Strings[j]; + end; + end; // next j + for j := 0 to NoInst - 1 do + begin + if (OS3MainFrm.DataGrid.Cells[i+1,0] = Instrumental.Items.Strings[j]) then + begin + InstCols[j] := i+1; +// result := VarTypeChk(i+1,0); +// if (result :=:= 1) goto cleanup; + InstLabels[j] := Instrumental.Items.Strings[j]; + end; + end; // next j + end; // next i + + // Get prox variables which are the variables common to exp and inst lists + NoProx := 0; + for i := 0 to NoInst - 1 do + begin + for j := 0 to NoExp - 1 do + begin + if (ExpLabels[j] = InstLabels[i]) then + begin + ProxLabels[NoProx] := 'P_' + InstLabels[i]; + ProxSrcLabels[NoProx] := InstLabels[i]; + ProxCols[NoProx] := InstCols[i]; + NoProx := NoProx + 1; + end; + end; + end; + + // Output Parameters of the Analysis + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('FILE: ' + OS3MainFrm.FileNameEdit.Text); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Dependent := ' + DepVarEdit.Text); + OutputFrm.RichEdit.Lines.Add('Explanatory Variables:'); + for i := 0 to NoExp - 1 do OutputFrm.RichEdit.Lines.Add(ExpLabels[i]); + OutputFrm.RichEdit.Lines.Add('Instrumental Variables:'); + for i := 0 to NoInst - 1 do OutputFrm.RichEdit.Lines.Add(InstLabels[i]); + OutputFrm.RichEdit.Lines.Add('Proxy Variables:'); + for i := 0 to NoProx - 1 do OutputFrm.RichEdit.Lines.Add(ProxLabels[i]); + OutputFrm.RichEdit.Lines.Add(''); + + // Compute the prox regressions for the instrumental variables + for i := 0 to NoProx - 1 do + begin + DictionaryFrm.DictGrid.ColCount := 8; + col := NoVariables + 1; +// NoVariables := col; + DictionaryFrm.NewVar(col); // create column for proxy (predicted values) + DictionaryFrm.DictGrid.Cells[1,col] := ProxLabels[i]; + OS3MainFrm.DataGrid.Cells[col,0] := ProxLabels[i]; + ProxSrcCols[i] := col; + DepProx := ProxCols[i]; + Noindep := 0; + for j := 0 to NoInst - 1 do + begin + if (DepProx <> InstCols[j]) then // don't include the prox itself! + begin + IndepCols[Noindep] := InstCols[j]; + RowLabels[Noindep] := InstLabels[j]; + Noindep := Noindep + 1; + end; + end; + for j := 0 to NoExp - 1 do + begin + found := false; + for k := 0 to NoProx - 1 do + if (ExpCols[j] = ProxCols[k]) then found := true; // don't include the proxs themselves + if (not found) then + begin + IndepCols[Noindep] := ExpCols[j]; + RowLabels[Noindep] := ExpLabels[j]; + Noindep := Noindep + 1; + end; + end; + IndepCols[Noindep] := DepProx; + OutputFrm.RichEdit.Lines.Add('Analysis for ' + ProxLabels[i]); + OutputFrm.RichEdit.Lines.Add('Dependent: ' + ProxSrcLabels[i]); + OutputFrm.RichEdit.Lines.Add('Independent: '); + for j := 0 to Noindep - 1 do OutputFrm.RichEdit.Lines.Add(RowLabels[j]); +// OutputFrm.ShowModal(); + mreg(Noindep, IndepCols, DepProx, RowLabels, Means, Variances, StdDevs, + BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, + NCases, errorcode, PrintDesc); + // save predicted scores at column := NoVariables and in ProxVals array + for j := 1 to NoCases do + begin + Y := 0.0; + for k := 0 to Noindep - 1 do + begin + col := IndepCols[k]; + X := StrToFloat(OS3MainFrm.DataGrid.Cells[col,j]); + Y := Y + BWeights[k] * X; + end; + Y := Y + BWeights[Noindep]; // intercept + col := NoVariables; + outstr := format('%12.5f',[Y]); + OS3MainFrm.DataGrid.Cells[col,j] := outstr; + end; // next case + end; // next proxy +// OutputFrm.ShowModal(); + + // Compute the OLS using the Prox values and explanatory + Noindep := 0; + counter := 0; + for i := 0 to NoExp - 1 do + begin + for j := 0 to NoInst - 1 do + begin + if (ExpLabels[i] = InstLabels[j]) then // use proxy + begin + IndepCols[Noindep] := ProxSrcCols[counter]; + RowLabels[Noindep] := ProxLabels[counter]; + counter := counter + 1; + break; + end + else + begin + IndepCols[Noindep] := ExpCols[i]; + RowLabels[Noindep] := ExpLabels[i]; + end; + end; + Noindep := Noindep + 1; + end; + PrintDesc := true; + PrintCorrs := true; + PrintInverse := false; + PrintCoefs := true; + SaveCorrs := false; + IndepCols[Noindep] := DepCol; + mreg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, + BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, + NCases, errorcode, PrintDesc); + OutputFrm.ShowModal; + if (SaveItChk.Checked) then + begin + PredictIt(IndepCols, Noindep+1, Means, StdDevs, BetaWeights, stderrest, Noindep); + end; + + // cleanup +cleanup: + ProxVals := nil; + ProxSrcLabels := nil; + ProxSrcCols := nil; + RowLabels := nil; + IndepCols := nil; + ProxLabels := nil; + ProxCols := nil; + InstCols := nil; + InstLabels := nil; + ExpCols := nil; + ExpLabels := nil; + tprobs := nil; + Bttests := nil; + BStdErrs := nil; + BetaWeights := nil; + BWeights := nil; + StdDevs := nil; + Variances := nil; + Means := nil; +end; + +procedure TTwoSLSFrm.DepOutClick(Sender: TObject); +begin + if (DepVarEdit.Text = '') then exit; + VarList.Items.Add(DepVarEdit.Text); + DepVarEdit.Text := ''; + DepIn.Enabled := true; + DepOut.Enabled := false; +end; + +procedure TTwoSLSFrm.ExpInClick(Sender: TObject); +VAR i : integer; +begin + if (VarList.Items.Count < 1) then exit; + i := 0; + while (i < VarList.Items.Count) do + begin + if (VarList.Selected[i]) then + begin + Explanatory.Items.Add(VarList.Items.Strings[i]); + end; + i := i + 1; + end; + ExpOut.Enabled := true; + if (VarList.Items.Count < 1) then ExpIn.Enabled := false; +end; + +procedure TTwoSLSFrm.ExpOutClick(Sender: TObject); +VAR index : integer; +begin + index := Explanatory.ItemIndex; + Explanatory.Items.Delete(index); + ExpIn.Enabled := true; + if (Explanatory.Items.Count < 1) then ExpOut.Enabled := false; +end; + +procedure TTwoSLSFrm.PredictIt(ColNoSelected : IntDyneVec; NoVars : integer; + Means, StdDevs, BetaWeights : DblDyneVec; + StdErrEst : double; NoIndepVars : integer); +VAR + col, i, j, k, Index: integer; + predicted, zpredicted, z1, z2, resid, residsqr : double; + astring : string; + +begin + // routine obtains predicted raw and standardized scores and their + // residuals. It is assumed that the dependent variable is last in the + // list of variable column pointers stored in the ColNoSelected vector. + // Get the z predicted score and its residual + col := NoVariables + 1; +// NoVariables := col; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'Pred.z'; + OS3MainFrm.DataGrid.Cells[col,0] := 'Pred.z'; + + col := NoVariables + 1; +// NoVariables := col; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'zResid.'; + OS3MainFrm.DataGrid.Cells[col,0] := 'zResid.'; + +// OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 2; + for i := 1 to NoCases do + begin + zpredicted := 0.0; + for j := 0 to NoIndepVars - 1 do + begin + k := ColNoSelected[j]; + z1 := (StrToFloat(OS3MainFrm.DataGrid.Cells[k,i]) - + Means[j]) / StdDevs[j]; + zpredicted := zpredicted + (z1 * BetaWeights[j]); + end; + astring := format('%8.4f',[zpredicted]); + OS3MainFrm.DataGrid.Cells[col-1,i] := astring; + Index := ColNoSelected[NoVars-1]; + z2 := StrToFloat(OS3MainFrm.DataGrid.Cells[Index,i]); + z2 := (z2 - Means[NoVars-1]) / StdDevs[NoVars-1]; // z score + astring := format('%8.4f',[z2 - zpredicted]); // z residual + OS3MainFrm.DataGrid.Cells[col,i] := astring; + end; + + // Get raw predicted and residuals + col := NoVariables + 1; +// NoVariables := col; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'Pred.Raw'; + OS3MainFrm.DataGrid.Cells[col,0] := 'Pred.Raw'; + + // calculate raw predicted scores and store in grid at col + for i := 1 to NoCases do + begin // predicted raw obtained from previously predicted z score + predicted := StrToFloat(OS3MainFrm.DataGrid.Cells[col-2,i]) * + StdDevs[NoVars-1] + Means[NoVars-1]; + astring := format('%8.3f',[predicted]); + OS3MainFrm.DataGrid.Cells[col,i] := astring; + end; + + // Calculate residuals of predicted raw scores begin + col := NoVariables +1; +// NoVariables := col; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'RawResid.'; + OS3MainFrm.DataGrid.Cells[col,0] := 'RawResid.'; + + for i := 1 to NoCases do + begin + Index := ColNoSelected[NoVars-1]; + resid := StrToFloat(OS3MainFrm.DataGrid.Cells[col-1,i]) - + StrToFloat(OS3MainFrm.DataGrid.Cells[Index,i]); + astring := format('%8.3f',[resid]); + OS3MainFrm.DataGrid.Cells[col,i] := astring; + end; + + // get square of raw residuals + col := NoVariables + 1; +// NoVariables := col; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'ResidSqr'; + OS3MainFrm.DataGrid.Cells[col,0] := 'ResidSqr'; + for i := 1 to NoCases do + begin + residsqr := StrToFloat(OS3MainFrm.DataGrid.Cells[col-1,i]); + residsqr := residsqr * residsqr; + astring := format('%8.3f',[residsqr]); + OS3MainFrm.DataGrid.Cells[col,i] := astring; + end; +end; + +initialization + {$I twoslsunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/wlsunit.lfm b/applications/lazstats/source/forms/analysis/multiple_regression/wlsunit.lfm new file mode 100644 index 000000000..905f97a34 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/wlsunit.lfm @@ -0,0 +1,449 @@ +object WLSFrm: TWLSFrm + Left = 288 + Height = 508 + Top = 171 + Width = 517 + AutoSize = True + Caption = 'Weighted Least Squares Regression' + ClientHeight = 508 + ClientWidth = 517 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 9 + Height = 15 + Top = 8 + Width = 46 + BorderSpacing.Left = 9 + BorderSpacing.Top = 8 + Caption = 'Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = DepVarEdit + Left = 280 + Height = 15 + Top = 33 + Width = 102 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = IndInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = IndInBtn + Left = 280 + Height = 15 + Top = 117 + Width = 116 + BorderSpacing.Left = 8 + Caption = 'Independent Variables' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = WghtInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = WghtVarEdit + Left = 280 + Height = 15 + Top = 287 + Width = 137 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'User''s Weigjhts (Optional)' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepInBtn + AnchorSideBottom.Control = GroupBox1 + Left = 9 + Height = 314 + Top = 25 + Width = 227 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 9 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object DepInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 244 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInBtnClick + Spacing = 0 + TabOrder = 1 + end + object DepOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepInBtn + AnchorSideTop.Side = asrBottom + Left = 244 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object IndInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepOutBtn + AnchorSideTop.Side = asrBottom + Left = 244 + Height = 28 + Top = 117 + Width = 28 + BorderSpacing.Top = 32 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = IndInBtnClick + Spacing = 0 + TabOrder = 4 + end + object IndOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = IndInBtn + AnchorSideTop.Side = asrBottom + Left = 244 + Height = 28 + Top = 149 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = IndOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object WghtInBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = WghtOutBtn + Left = 244 + Height = 28 + Top = 279 + Width = 28 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = WghtInBtnClick + Spacing = 0 + TabOrder = 7 + end + object WghtOutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 244 + Height = 28 + Top = 311 + Width = 28 + Anchors = [akLeft, akBottom] + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = WghtOutBtnClick + Spacing = 0 + TabOrder = 8 + end + object DepVarEdit: TEdit + AnchorSideLeft.Control = DepInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOutBtn + AnchorSideBottom.Side = asrBottom + Left = 280 + Height = 23 + Top = 50 + Width = 229 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'DepVarEdit' + end + object IndVarList: TListBox + AnchorSideLeft.Control = IndInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = WghtInBtn + Left = 280 + Height = 129 + Top = 134 + Width = 229 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 16 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 6 + end + object WghtVarEdit: TEdit + AnchorSideLeft.Control = WghtInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = WghtOutBtn + AnchorSideBottom.Side = asrBottom + Left = 280 + Height = 23 + Top = 304 + Width = 229 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 9 + Text = 'WghtVarEdit' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 112 + Top = 347 + Width = 491 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Options' + ClientHeight = 92 + ClientWidth = 487 + TabOrder = 10 + object OLSChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + Left = 12 + Height = 19 + Top = 2 + Width = 206 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + Caption = 'Obtain OLS , save squared residuals' + TabOrder = 0 + end + object PlotChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = OLSChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 23 + Width = 216 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + Caption = 'Plot squared residuals vs. Indep. Vars.' + TabOrder = 1 + end + object RegResChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = PlotChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 44 + Width = 235 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + Caption = 'Regress squared residuals on Indep. Vars.' + TabOrder = 2 + end + object SaveChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = RegResChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 65 + Width = 180 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 8 + Caption = 'Save Estimated weights in grid' + TabOrder = 3 + end + object WeightChk: TCheckBox + AnchorSideLeft.Control = RegResChk + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox1 + Left = 263 + Height = 19 + Top = 2 + Width = 216 + BorderSpacing.Left = 16 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Caption = 'Apply weights and obtain a WLS Reg.' + TabOrder = 4 + end + object OriginChk: TCheckBox + AnchorSideLeft.Control = WeightChk + AnchorSideTop.Control = WeightChk + AnchorSideTop.Side = asrBottom + Left = 287 + Height = 19 + Top = 23 + Width = 121 + BorderSpacing.Left = 24 + BorderSpacing.Top = 2 + Caption = 'Through the Origin' + TabOrder = 5 + end + object UserWghtsChk: TCheckBox + AnchorSideLeft.Control = WeightChk + AnchorSideTop.Control = OriginChk + AnchorSideTop.Side = asrBottom + Left = 263 + Height = 19 + Top = 44 + Width = 189 + BorderSpacing.Top = 2 + Caption = 'Use Weights entered by the user' + TabOrder = 6 + end + object Origin2Chk: TCheckBox + AnchorSideLeft.Control = OriginChk + AnchorSideTop.Control = UserWghtsChk + AnchorSideTop.Side = asrBottom + Left = 287 + Height = 19 + Top = 65 + Width = 121 + BorderSpacing.Top = 2 + Caption = 'Through the Origin' + TabOrder = 7 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 296 + Height = 25 + Top = 475 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 12 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 362 + Height = 25 + Top = 475 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 13 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 450 + Height = 25 + Top = 475 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 14 + end + object HelpBtn: TButton + Tag = 158 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 233 + Height = 25 + Top = 475 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 11 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ResetBtn + Left = 0 + Height = 8 + Top = 459 + Width = 517 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/multiple_regression/wlsunit.pas b/applications/lazstats/source/forms/analysis/multiple_regression/wlsunit.pas new file mode 100644 index 000000000..3a010e060 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multiple_regression/wlsunit.pas @@ -0,0 +1,963 @@ +unit WLSUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + Globals, MainUnit, DictionaryUnit, FunctionsLib, Matrixlib, PlotXYUnit, + OutputUnit, DataProcs, BlankFrmUnit, ContextHelpUnit; + +type + + { TWLSFrm } + + TWLSFrm = class(TForm) + Bevel1: TBevel; + DepInBtn: TBitBtn; + DepOutBtn: TBitBtn; + HelpBtn: TButton; + IndInBtn: TBitBtn; + IndOutBtn: TBitBtn; + WghtInBtn: TBitBtn; + WghtOutBtn: TBitBtn; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + OLSChk: TCheckBox; + PlotChk: TCheckBox; + RegResChk: TCheckBox; + SaveChk: TCheckBox; + WeightChk: TCheckBox; + OriginChk: TCheckBox; + UserWghtsChk: TCheckBox; + Origin2Chk: TCheckBox; + DepVarEdit: TEdit; + WghtVarEdit: TEdit; + GroupBox1: TGroupBox; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + IndVarList: TListBox; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure DepInBtnClick(Sender: TObject); + procedure DepOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure IndInBtnClick(Sender: TObject); + procedure IndOutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + procedure WghtInBtnClick(Sender: TObject); + procedure WghtOutBtnClick(Sender: TObject); + procedure PredictIt(ColNoSelected : IntDyneVec; NoVars : integer; + Means, StdDevs, BetaWeights : DblDyneVec; + StdErrEst : double; NoIndepVars : integer); + procedure PlotXY(Xpoints, Ypoints, UpConf, LowConf : DblDyneVec; + ConfBand, Xmean, Ymean, R, Slope, Intercept : double; + Xmax, Xmin, Ymax, Ymin : double; + N : integer; XLabel, YLabel : string); + + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + WLSFrm: TWLSFrm; + +implementation + +uses + Math; + +{ TWLSFrm } + +procedure TWLSFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + for i := 0 to NoVariables - 1 do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i+1,0]); + IndVarList.Clear; + DepVarEdit.Text := ''; + WghtVarEdit.Text := ''; + DepInBtn.Enabled := true; + DepOutBtn.Enabled := false; + IndInBtn.Enabled := true; + IndOutBtn.Enabled := false; + WghtInBtn.Enabled := true; + WghtOutBtn.Enabled := false; + OLSChk.Checked := true; + PlotChk.Checked := true; + RegResChk.Checked := true; + WeightChk.Checked := true; + UserWghtsChk.Checked := false; + OriginChk.Checked := true; + Origin2Chk.Checked := true; +end; + +procedure TWLSFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TWLSFrm.WghtInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (WghtVarEdit.Text = '') then + begin + WghtVarEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TWLSFrm.WghtOutBtnClick(Sender: TObject); +begin + if (WghtVarEdit.Text <> '') then + begin + VarList.Items.Add(WghtVarEdit.Text); + WghtVarEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TWLSFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := True; +end; + +procedure TWLSFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if BlankFrm = nil then Application.CreateForm(TBlankFrm, BlankFrm); + if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TWLSFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TWLSFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TWLSFrm.IndInBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while (i < VarList.Items.Count) do + begin + if (VarList.Selected[i]) then + begin + IndVarList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TWLSFrm.IndOutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while (i < IndVarList.Items.Count) do + begin + if IndVarlist.Selected[i] then + begin + VarList.Items.Add(IndVarList.Items[i]); + IndVarlist.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TWLSFrm.DepInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepVarEdit.Text = '') then + begin + DepVarEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TWLSFrm.DepOutBtnClick(Sender: TObject); +begin + if (DepVarEdit.Text <> '') then + begin + VarList.Items.Add(DepVarEdit.Text); + DepVarEdit.Text := ''; + end; + UpdateBtnStates; +end; + + +procedure TWLSFrm.ComputeBtnClick(Sender: TObject); +VAR + i, ii, j, Noindep, DepCol, WghtCol, olddepcol, NCases, pos, col : integer; + IndepCols : IntDyneVec; + RowLabels : StrDyneVec; + X, Y : double; + Means, Variances, StdDevs, BWeights : DblDyneVec; + BetaWeights, BStdErrs, Bttests, tprobs : DblDyneVec; + PrintDesc : boolean; + Xpoints, Ypoints, UpConf, lowConf : DblDyneVec; + Xmax, Xmin, Ymax, Ymin, Xmean, Ymean, Xvariance, Yvariance, R : double; + temp, SEPred, Slope, Intercept, DF, SSx, t, ConfBand, sedata : double; + Xstddev, Ystddev, predicted : double; + ColNoSelected : IntDyneVec; + XLabel, YLabel : string; + N, Xcol, Ycol, NoSelected : integer; + lReport: TStrings; + StdErrEst: Double = 0.0; + R2: Double = 0.0; + errorcode: Boolean = false; +begin + PrintDesc := true; + + SetLength(Means, NoVariables + 2); + SetLength(Variances, NoVariables + 2); + SetLength(StdDevs, NoVariables + 2); + SetLength(BWeights, NoVariables + 2); + SetLength(BetaWeights, NoVariables + 2); + SetLength(BStdErrs, NoVariables + 2); + SetLength(Bttests, NoVariables + 2); + SetLength(tprobs, NoVariables + 2); + SetLength(RowLabels, NoVariables + 2); + SetLength(IndepCols, NoVariables + 2); + SetLength(Xpoints, NoCases + 1); + SetLength(Ypoints, NoCases + 1); + SetLength(UpConf, NoCases + 1); + SetLength(lowConf, NoCases + 1); + SetLength(ColNoSelected, 2); + + lReport := TStringList.Create; + try + NCases := NoCases; + Noindep := IndVarList.Items.Count; + if (Noindep = 0) then + begin + MessageDlg('No independent variables selected.', mtError, [mbOK], 0); + exit; + end; + + DepCol := 0; + WghtCol := 0; + for i := 0 to NoVariables - 1 do + begin + if (OS3MainFrm.DataGrid.Cells[i+1,0] = DepVarEdit.Text) then DepCol := i+1; + if (OS3MainFrm.DataGrid.Cells[i+1,0] = WghtVarEdit.Text) then WghtCol := i+1; + for j := 0 to Noindep - 1 do + begin + if (OS3MainFrm.DataGrid.Cells[i+1,0] = IndVarList.Items.Strings[j]) then + begin + IndepCols[j] := i+1; + RowLabels[j] := IndVarList.Items.Strings[j]; + end; + end; // next j + end; // next i + + if (DepCol = 0) then + begin + MessageDlg('No dependent variable selected.', mtError, [mbOK], 0); + exit; + end; + + // check variable types + if not ValidValue(DepCol,0) then + begin + MessageDlg('Incorrect dependent variable type.', mtError, [mbOK], 0); + exit; + end; + + if (WghtCol > 0) then + begin + if not ValidValue(WghtCol,0) then + begin + MessageDlg('Incorrect weight variable type.', mtError, [mbOK], 0); + exit; + end; + end; + + for j := 0 to Noindep - 1 do + begin + if not ValidValue(IndepCols[j],0) then + begin + MessageDlg('Incorrect dependent variable type.', mtError, [mbOK], 0); + exit; + end; + end; + + IndepCols[NoIndep] := DepCol; + olddepcol := DepCol; // save dependent column so we can reuse DepCol + + // Get OLS regression + if OLSChk.Checked then + begin + lReport.Add('OLS REGRESSION RESULTS'); + MReg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, + BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, + NCases, errorcode, PrintDesc, lReport); + + // Get predicted z score, residual z score, predicted raw score, + // residual raw score and squared raw residual score. Place in the DataGrid + PredictIt(IndepCols, Noindep+1, Means, StdDevs, BetaWeights, stderrest, Noindep); + + lReport.Add(''); + lReport.Add('=================================================================================='); + lReport.Add(''); + end; + + if RegResChk.Checked and OLSChk.Checked then + begin + // Regress the squared residuals on the predictors + DepCol := NoVariables; + lReport.Add('REGRESSION OF SQUARED RESIDUALS ON INDEPENDENT VARIABLES'); + MReg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, + BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, + NCases, errorcode, PrintDesc, lReport); + DisplayReport(lReport); + lReport.Clear; +// lReport.Add(''); +// lReport.Add('=================================================================================='); +// lReport.Add(''); + end; + + if WeightChk.Checked and RegResChk.Checked then + begin + // Get predicted squared residuals and save recipricols as weights + col := NoVariables + 1; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'PredResid2'; + OS3MainFrm.DataGrid.Cells[col,0] := 'PredResid2'; + + col := NoVariables + 1; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'WEIGHT'; + OS3MainFrm.DataGrid.Cells[col,0] := 'WEIGHT'; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + + for i := 1 to NoCases do + begin + if (ValidValue(i,col-2)) then // do we have a valid squared OLS residual? + begin + predicted := 0.0; + for j := 0 to Noindep - 1 do + begin + pos := IndepCols[j]; + X := StrToFloat(OS3MainFrm.DataGrid.Cells[pos,i]); + predicted := predicted + BWeights[j] * X; + end; + predicted := predicted + BWeights[Noindep]; + predicted := abs(predicted); + OS3MainFrm.DataGrid.Cells[col-1,i] := Format('%8.3f', [predicted]); + if (predicted > 0.0) then + predicted := 1.0 / sqrt(predicted) + else + predicted := 0.0; + OS3MainFrm.DataGrid.Cells[col,i] := Format('%8.3f', [predicted]); + end; // if valid case + end; // next i + end; // if regresChk + + // Now, plot squared residuals against each independent variable + if PlotChk.Checked and RegResChk.Checked then + begin + Xcol := DepCol; + for ii := 0 to NoIndep - 1 do + begin + Ycol := IndepCols[ii]; + N := 0; + ColNoSelected[0] := Xcol; + ColNoSelected[1] := Ycol; + NoSelected := 2; + XLabel := OS3MainFrm.DataGrid.Cells[Xcol,0]; + YLabel := OS3MainFrm.DataGrid.Cells[Ycol,0]; + Xmax := -1.0e308; + Xmin := 1.0e308; + Ymax := -1.0e308; + Ymin := 1.0e308; + Xmean := 0.0; + Ymean := 0.0; + Xvariance := 0.0; + Yvariance := 0.0; + R := 0.0; + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + N := N + 1; + X := StrToFloat(OS3MainFrm.DataGrid.Cells[Xcol,i]); + Y := StrToFloat(OS3MainFrm.DataGrid.Cells[Ycol,i]); + Xpoints[N] := X; + Ypoints[N] := Y; + if (X > Xmax) then Xmax := X; + if (X < Xmin) then Xmin := X; + if (Y > Ymax) then Ymax := Y; + if (Y < Ymin) then Ymin := Y; + Xmean := Xmean + X; + Ymean := Ymean + Y; + Xvariance := Xvariance + X * X; + Yvariance := Yvariance + Y * Y; + R := R + X * Y; + end; + + // sort on X + for i := 1 to N - 1 do + begin + for j := i + 1 to N do + begin + if (Xpoints[i] > Xpoints[j]) then //swap + begin + temp := Xpoints[i]; + Xpoints[i] := Xpoints[j]; + Xpoints[j] := temp; + temp := Ypoints[i]; + Ypoints[i] := Ypoints[j]; + Ypoints[j] := temp; + end; + end; + end; + + // calculate statistics + Xvariance := Xvariance - Xmean * Xmean / N; + SSx := Xvariance; + Xvariance := Xvariance / (N - 1); + Xstddev := sqrt(Xvariance); + + Yvariance := Yvariance - Ymean * Ymean / N; + Yvariance := Yvariance / (N - 1); + Ystddev := sqrt(Yvariance); + + R := R - Xmean * Ymean / N; + R := R / (N - 1); + R := R / (Xstddev * Ystddev); + + SEPred := sqrt(1.0 - R * R) * Ystddev; + SEPred := SEPred * sqrt((N - 1) / (N - 2)); + Xmean := Xmean / N; + Ymean := Ymean / N; + Slope := R * Ystddev / Xstddev; + Intercept := Ymean - Slope * Xmean; + + // Now, print the descriptive statistics if requested + lReport.Add('X versus Y Plot'); + lReport.Add(''); + lReport.Add('X = %s, Y = %s from file %s', [ + OS3MainFrm.DataGrid.Cells[Xcol,0], + OS3MainFrm.DataGrid.Cells[Ycol,0], + OS3MainFrm.FileNameEdit.Text + ]); + lReport.Add(''); + lReport.Add('Variable Mean Variance Std.Dev.'); + lReport.Add('%-10s%8.2f %8.2f %8.2f', [OS3MainFrm.DataGrid.Cells[Xcol,0], Xmean, Xvariance, Xstddev]); + lReport.Add('%-10s%8.2f %8.2f %8.2f', [OS3MainFrm.DataGrid.Cells[Ycol,0], Ymean, Yvariance, Ystddev]); + lReport.Add(''); + lReport.Add('Correlation: %8.4f', [R]); + lReport.Add('Slope: %8.2f', [Slope]); + lReport.Add('Intercept: %8.2f', [Intercept]); + lReport.Add('Standard Error of Estimate: %8.2f', [SEPred]); + lReport.Add('Number of good cases: %8d', [N]); + + DisplayReport(lReport); + lReport.Clear; +// lReport.Add(''); +// lReport.Add('=================================================================================='); +// lReport.Add(''); + + // get upper and lower confidence points for each X value + ConfBand := 0.95; + DF := N - 2; + t := inverset(ConfBand,DF); + for i := 1 to N do + begin + X := Xpoints[i]; + predicted := Slope * X + Intercept; + sedata := SEPred * sqrt(1.0 + (1.0 / N) + ((X - Xmean) * (X - Xmean) / SSx)); + UpConf[i] := predicted + (t * sedata); + lowConf[i] := predicted - (t * sedata); + if (UpConf[i] > Ymax) then Ymax := UpConf[i]; + if (lowConf[i] < Ymin) then Ymin := lowConf[i]; + end; + + // plot the values (and optional line and confidence band if elected) + PlotXY(Xpoints, Ypoints, UpConf, lowConf, ConfBand, Xmean, Ymean, R, + Slope, Intercept, Xmax, Xmin, Ymax, Ymin, N, XLabel, YLabel); + BlankFrm.ShowModal; + end; + end; + + if UserWghtsChk.Checked then + begin + // Weight variables and do OLS regression on weighted variables + DepCol := olddepcol; + IndepCols[Noindep] := DepCol; + for i := 1 to NoCases do + begin + Y := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[NoVariables,i])); // weight + for j := 0 to Noindep do + begin + pos := IndepCols[j]; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[pos,i])); + X := X * Y; + OS3MainFrm.DataGrid.Cells[pos,i] := FloatToStr(X); + end; + end; + + // get means of variables and subtract from the values + if OriginChk.Checked then + begin + for j := 0 to Noindep do + begin + Means[j] := 0.0; + NCases := 0; + pos := IndepCols[j]; + for i := 1 to NoCases do + begin + if (ValidValue(i,pos)) then + begin + Means[j] := Means[j] + StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[pos,i])); + NCases := NCases + 1; + end; + end; + Means[j] := Means[j] / NCases; + for i := 1 to NoCases do + begin + if (ValidValue(i,pos)) then + begin + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[pos,i])); + X := X - Means[j]; + OS3MainFrm.DataGrid.Cells[pos,i] := FloatToStr(X); + end; + end; // next i + end; // next j + end; // if origin checked + + lReport.Add('WLS REGRESSION RESULTS'); + MReg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, + BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, + NCases, errorcode, PrintDesc, lReport); + DisplayReport(lReport); + end // if useweightschk checked + else + // use the weights entered by the user + if (UserWghtsChk.Checked) then + begin + // Weight variables and do OLS regression on weighted variables + DepCol := olddepcol; + IndepCols[Noindep] := DepCol; + for i := 1 to NoCases do + begin + Y := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[WghtCol,i])); // weight + for j := 0 to Noindep do + begin + pos := IndepCols[j]; + X := StrToFloat(OS3MainFrm.DataGrid.Cells[pos,i]); + X := X * Y; + OS3MainFrm.DataGrid.Cells[pos,i] := FloatToStr(X); + end; + end; + if (OriginChk.Checked) then // get means of variables and subtract from the values + begin + for j := 0 to Noindep do + begin + Means[j] := 0.0; + NCases := 0; + pos := IndepCols[j]; + for i := 1 to NoCases do + begin + if (ValidValue(i,pos)) then + begin + Means[j] := Means[j] + StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[pos,i])); + NCases := NCases + 1; + end; + end; + Means[j] := Means[j] / NCases; + for i := 1 to NoCases do + begin + if (ValidValue(i,pos)) then + begin + X := StrToFloat(OS3MainFrm.DataGrid.Cells[pos,i]); + X := X - Means[j]; + OS3MainFrm.DataGrid.Cells[pos,i] := FloatToStr(X); + end; + end; // next i + end; // next j + end; // if origin checked + + lReport.Add('WLS REGRESSION RESULTS'); + MReg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, + BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, + NCases, errorcode, PrintDesc, lReport); + DisplayReport(lReport); + end; + + finally + lReport.Free; + + IndepCols := nil; + RowLabels := nil; + tprobs := nil; + Bttests := nil; + BStdErrs := nil; + BetaWeights := nil; + BWeights := nil; + StdDevs := nil; + Variances := nil; + Means := nil; + ColNoSelected := nil; + lowConf := nil; + UpConf := nil; + Ypoints := nil; + Xpoints := nil; + + // reset the variables for possible second step of WLS + //ResetBtnClick(self); + end; +end; + +procedure TWLSFrm.PredictIt(ColNoSelected: IntDyneVec; NoVars: integer; + Means, StdDevs, BetaWeights: DblDyneVec; + StdErrEst: double; NoIndepVars: integer); +VAR + col, i, j, k, Index: integer; + predicted, zpredicted, z1, z2, resid, residsqr : double; +begin + // routine obtains predicted raw and standardized scores and their + // residuals. It is assumed that the dependent variable is last in the + // list of variable column pointers stored in the ColNoSelected vector. + // Get the z predicted score and its residual + col := NoVariables + 1; +// NoVariables := col; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + DictionaryFrm.DictGrid.ColCount := 8; + DictionaryFrm.NewVar(col); + OS3MainFrm.DataGrid.Cells[col,0] := 'Pred.z'; + DictionaryFrm.DictGrid.Cells[1,col] := 'Pred.z'; + + col := NoVariables + 1; +// NoVariables := col; + DictionaryFrm.NewVar(col); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + OS3MainFrm.DataGrid.Cells[col,0] := 'z Resid.'; + DictionaryFrm.DictGrid.Cells[1,col] := 'z Resid.'; + OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 2; + for i := 1 to NoCases do + begin + zpredicted := 0.0; + for j := 0 to NoIndepVars - 1 do + begin + k := ColNoSelected[j]; + z1 := (StrToFloat(OS3MainFrm.DataGrid.Cells[k,i]) - Means[j]) / StdDevs[j]; + zpredicted := zpredicted + (z1 * BetaWeights[j]); + end; + OS3MainFrm.DataGrid.Cells[col-1,i] := Format('%8.4f',[zpredicted]); + + if StdDevs[NoVars-1] <> 0.0 then + begin + Index := ColNoSelected[NoVars-1]; + z2 := StrToFloat(OS3MainFrm.DataGrid.Cells[Index,i]); + z2 := (z2 - Means[NoVars-1]) / StdDevs[NoVars-1]; // z score + OS3MainFrm.DataGrid.Cells[col,i] := Format('%8.4f',[z2 - zpredicted]); // z residual + end; + end; + + // Get raw predicted and residuals + col := NoVariables + 1; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'Pred.Raw'; + OS3MainFrm.DataGrid.Cells[col,0] := 'Pred.Raw'; + // calculate raw predicted scores and store in DataGrid at col + for i := 1 to NoCases do + begin // predicted raw obtained from previously predicted z score + predicted := StrToFloat(OS3MainFrm.DataGrid.Cells[col-2,i]) * StdDevs[NoVars-1] + Means[NoVars-1]; + OS3MainFrm.DataGrid.Cells[col,i] := Format('%8.3f',[predicted]); + end; + + // Calculate residuals of predicted raw scores end; + col := NoVariables +1; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'Raw Resid.'; + OS3MainFrm.DataGrid.Cells[col,0] := 'Raw Resid.'; + + for i := 1 to NoCases do + begin + Index := ColNoSelected[NoVars-1]; + resid := StrToFloat(OS3MainFrm.DataGrid.Cells[col-1,i]) - StrToFloat(OS3MainFrm.DataGrid.Cells[Index,i]); + OS3MainFrm.DataGrid.Cells[col,i] := Format('%8.3f',[resid]); + end; + + // get square of raw residuals + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + DictionaryFrm.DictGrid.Cells[1,col] := 'ResidSqr'; + OS3MainFrm.DataGrid.Cells[col,0] := 'ResidSqr'; + for i := 1 to NoCases do + begin + residsqr := StrToFloat(OS3MainFrm.DataGrid.Cells[col-1,i]); + residsqr := residsqr * residsqr; + OS3MainFrm.DataGrid.Cells[col,i] := Format('%8.3f',[residsqr]); + end; +end; + +procedure TWLSFrm.PlotXY(Xpoints, Ypoints, UpConf, LowConf : DblDyneVec; + ConfBand, Xmean, Ymean, R, Slope, Intercept : double; + Xmax, Xmin, Ymax, Ymin : double; + N : integer; XLabel, YLabel : string); +VAR + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; + vhi, hwide, offset, strhi, imagehi : integer; + valincr, Yvalue, Xvalue, value : double; + Title, outline : string; + +begin + BlankFrm.Image1.Canvas.Clear; + Title := 'X versus Y PLOT Using File: ' + OS3MainFrm.FileNameEdit.Text; + BlankFrm.Caption := Title; + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Rectangle(0,0,imagewide,imagehi); + BlankFrm.Image1.Canvas.FloodFill(0,0,clWhite,fsBorder); + vtop := 20; + vbottom := round(imagehi) - 80; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + + // Draw chart border + BlankFrm.Image1.Canvas.Rectangle(0,0,imagewide,imagehi); + + // draw Means + ypos := round(vhi * ( (Ymax - Ymean) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clGreen; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'MEAN '; + Title := Title + YLabel; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + xpos := round(hwide * ( (Xmean - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + ypos := vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := vbottom; + BlankFrm.Image1.Canvas.Pen.Color := clGreen; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'MEAN '; + Title := Title + XLabel; + strhi := BlankFrm.Image1.Canvas.TextWidth(Title); + xpos := xpos - strhi div 2; + ypos := vtop - BlankFrm.Image1.Canvas.TextHeight(Title); + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + // draw slope line + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + Yvalue := (Xpoints[1] * Slope) + Intercept; // predicted score + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[1]- Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + Yvalue := (Xpoints[N] * Slope) + Intercept; // predicted score + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[N] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + + // draw horizontal axis + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom); + valincr := (Xmax - Xmin) / 10.0; + for i := 1 to 11 do + begin + ypos := vbottom; + Xvalue := Xmin + valincr * (i - 1); + xpos := round(hwide * ((Xvalue - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + outline := format('%6.2f',[Xvalue]); + Title := outline; + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + xpos := xpos - offset; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(XLabel) div 2); + ypos := vbottom + 20; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,XLabel); + outline := format('R(X,Y) := %5.3f, Slope := %6.2f, Intercept := %6.2f', + [R,Slope,Intercept]); + Title := outline; + xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(Title) div 2); + ypos := ypos + 15; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + // Draw vertical axis + Title := YLabel; +// xpos := hleft - 10 - BlankFrm.Image1.Canvas.TextWidth(Title) / 2; + xpos := 10; + ypos := vtop - 8 - BlankFrm.Image1.Canvas.TextHeight(Title); + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,YLabel); + xpos := hleft; + ypos := vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := vbottom; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + valincr := (Ymax - Ymin) / 10.0; + for i := 1 to 11 do + begin + value := Ymax - ((i-1) * valincr); + outline := format('%8.2f',[value]); + Title := outline; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := 10; + Yvalue := Ymax - (valincr * (i-1)); + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + xpos := hleft; + ypos := ypos + strhi div 2; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hleft - 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // draw points for x and y pairs + for i := 1 to N do + begin + ypos := round(vhi * ( (Ymax - Ypoints[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.Brush.Color := clNavy; + BlankFrm.Image1.Canvas.Brush.Style := bsSolid; + BlankFrm.Image1.Canvas.Pen.Color := clNavy; + BlankFrm.Image1.Canvas.Ellipse(xpos,ypos,xpos+5,ypos+5); + end; + + // draw confidence bands if requested + if not (ConfBand = 0.0) then + begin + BlankFrm.Image1.Canvas.Pen.Color := clRed; + ypos := round(vhi * ((Ymax - UpConf[1]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[1] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + for i := 2 to N do + begin + ypos := round(vhi * ((Ymax - UpConf[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + ypos := round(vhi * ((Ymax - LowConf[1]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[1] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + for i := 2 to N do + begin + ypos := round(vhi * ((Ymax - LowConf[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + end; +end; + +procedure TWLSFrm.UpdateBtnStates; +var + i: Integer; + lSelected: Boolean; +begin + lSelected := false; + for i:=0 to VarList.Items.Count-1 do + if Varlist.Selected[i] then + begin + lSelected := true; + break; + end; + DepInBtn.Enabled := lSelected and (DepVarEdit.Text = ''); + IndInBtn.Enabled := lSelected; + WghtInBtn.Enabled := lSelected and (WghtVarEdit.Text = ''); + + lSelected := false; + for i:=0 to IndVarList.Items.Count-1 do + if IndVarList.Selected[i] then + begin + lSelected := true; + break; + end; + DepOutBtn.Enabled := (DepVarEdit.Text <> ''); + IndOutBtn.Enabled := lSelected; + WghtOutBtn.Enabled := (WghtVarEdit.Text <> ''); +end; + + +initialization + {$I wlsunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.lfm new file mode 100644 index 000000000..7dc9c165c --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.lfm @@ -0,0 +1,139 @@ +object AvgLinkFrm: TAvgLinkFrm + Left = 589 + Height = 136 + Top = 409 + Width = 382 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Average Linkage Hierarchical Clustering' + ClientHeight = 136 + ClientWidth = 382 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object RadioGroup1: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 131 + Height = 72 + Top = 8 + Width = 120 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Matrix Type Is:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 116 + Items.Strings = ( + 'Similarities' + 'Dissimilarities' + ) + TabOrder = 0 + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Side = asrBottom + Left = 147 + Height = 25 + Top = 96 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object ComputeBtn: TButton + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Side = asrBottom + Left = 221 + Height = 25 + Top = 96 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 3 + end + object ReturnBtn: TButton + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 309 + Height = 25 + Top = 96 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 4 + end + object HelpBtn: TButton + Tag = 105 + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Side = asrBottom + Left = 84 + Height = 25 + Top = 96 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 1 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = RadioGroup1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 80 + Width = 382 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.pas b/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.pas new file mode 100644 index 000000000..a2bb40bfd --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.pas @@ -0,0 +1,528 @@ +unit AvgLinkUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, + Dialogs, StdCtrls, ExtCtrls, + MainUnit, Globals, OutputUnit, ContextHelpUnit; + +type + + { TAvgLinkFrm } + + TAvgLinkFrm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + ComputeBtn: TButton; + HelpBtn: TButton; + ReturnBtn: TButton; + RadioGroup1: TRadioGroup; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure TreePlot(Clusters : IntDyneMat; Lst : IntDyneVec; NoPoints : integer); + procedure PreTree(NN, CRIT : integer; LST : IntDyneVec; KLUS : IntDyneMat); + + private + { private declarations } + public + { public declarations } + end; + +var + AvgLinkFrm: TAvgLinkFrm; + +implementation + +uses + Math; + +{ TAvgLinkFrm } + +procedure TAvgLinkFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([HelpBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure TAvgLinkFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TAvgLinkFrm.FormShow(Sender: TObject); +begin + RadioGroup1.ItemIndex := 0; +end; + +procedure TAvgLinkFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TAvgLinkFrm.ComputeBtnClick(Sender: TObject); +VAR + X : DblDyneMat; // similarity or dissimilarity matrix + KLUS : IntDyneMat; + LST : IntDyneVec; + RX, SAV, SAV2, RRRMIN : double; + NIN, NVAR : IntDyneVec; + I, J, K, L, M, MN, N, CRIT, ITR, LIMIT : integer; +// ROWS : StrDyneVec; + DIS, Title : string; + outline : string; + nvalues : integer; +label label300, label60, label70; + +begin + // Reference: Anderberg, M. R. (1973). Cluster analysis for + // applications. New York: Academic press. + // + // Almost any text on cluster analysis should have a good + // description of the average-linkage hierarchical clustering + // algorithm. The algorithm begins with an initial similarity + // or dissimilarity matrix between pairs of objects. The + // algorithm proceeds in an iterative way. At each iteration + // the two most similar (we assume similarities for explanation) + // objects are combined into one group. At each successive + // iteration, the two most similar objects or groups of objects are + // merged. Similarity between groups is defined as the average + // similarity between objects in one group with objects in the other. + // + // INPUT: A correlation matrix (or some other similarity or + // dissimilarity matrix) in a file named MATRIX.DAT + // This must contain all the elements of a full + // (n x n), symmetrical matrix. Any format is + // allowable, as long as numbers are separated by + // blanks. + // + // OUTPUT: Output consists of a cluster history and a tree + // diagram (dendogram). The cluster history + // indicates, for each iteration, the objects + // or clusters merged, and the average pairwise + // similarity or dissimilarity in the resulting + // cluster. + // + // Author: John Uebersax + + nvalues := NoVariables; + if (NoVariables <= 0) then + begin + ShowMessage('ERROR! You must first load a matrix into the grid.'); + exit; + end; + + SetLength(X,nvalues+1,nvalues+1); + SetLength(KLUS,nvalues+1,3); + SetLength(LST,nvalues+1); + SetLength(NIN,nvalues+1); + SetLength(NVAR,nvalues+1); + + Title := 'Average Linkage Cluster Analysis. Adopted from ClusBas by John S. Uebersax'; + + // This section does the cluster analysis, taking data from the Main Form. + // Parameters controlling the analysis are obtained from the dialog form. + DIS := 'DIS'; + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(Title); + OutputFrm.RichEdit.Lines.Add(''); + M := nvalues; + CRIT := RadioGroup1.ItemIndex; // 0 := Similarity, 1 := dissimilarity + + // get matrix of data from OS3MainFrm + for i := 1 to NoVariables do + begin + for j := 1 to NoVariables do + X[i,j] := StrToFloat(OS3MainFrm.DataGrid.Cells[i,j]); + end; + + LIMIT := M - 1; + for i := 1 to M do + begin + NVAR[i] := i; + NIN[i] := 1; + end; + + // cluster analysis + ITR := 0; + +label300: + ITR := ITR + 1; + // + // determine groups to be merged this iteration + // + if (CRIT = 1) then // (BSCAN) dissimilarity matrix + begin + // This section looks for the minimum dissimilarity. It finds + // element (K, L), where K and L are the most dissimilar objects + // or groups. + // + N := 1; + RRRMIN := 1000000.0; + MN := M - 1; + for i := 1 to MN do + begin + N := N + 1; + for j := N to M do + begin + if (RRRMIN < 0.0) then continue; + K := i; + L := j; + RRRMIN := X[i,j]; + end; + end; + RX := RRRMIN; + end else // SCAN procedure + begin + // This section looks for the maximum similarity. It finds + // element (K, L), where K and L are the most similar objects or + // groups. + // + N := 1; + RX := -10000.0; + for i := 1 to M do + begin + N := N + 1; + for j := N to M do + begin + if (RX - X[i,j] > 0.0) then continue; + K := i; + L := j; + RX := X[i,j]; + end; + end; + end; + + // ARRANGE + // + // This section updates the similarity or dissimilarity matrix. + // If two objects/groups K and L are merged, it calculates the + // similarity or dissimilarity of the new group with all other objects + // or groups. It does this by averaging the elements in row K of + // X() with those in row L, and similarly for columns K and L. + // The new elements are put in row K and column L (K < L). Row K + // and column L are deleted. Columns and rows greater than L are + // shifted up one column or row to fill in the gap. The resulting + // matrix X() thus has one less column and row then at the beginning + // of the subroutine. + + MN := M - 1; + SAV := X[K,L]; + SAV2 := X[K,K]; + // Calculate similarity or dissimilarity of group formed by merging I + // and J to all other groups by averaging the similarities or + // dissimilarities of I and J with other groups + for I := 1 to M do + begin + X[I,K] := (X[I,K] * NIN[K] + X[I,L] * NIN[L]) / (NIN[K] + NIN[L]); + X[K,I] := X[I,K]; + end; + X[K,K] := SAV2 * NIN[K] * (NIN[K] - 1) + X[L,L] * NIN[L] * (NIN[L] - 1); + X[K,K] := X[K,K] + SAV * 2 * NIN[K] * NIN[L]; + X[K,K] := X[K,K] / ((NIN[K] + NIN[L]) * (NIN[K] + NIN[L] - 1)); + if (L = M) then goto label60; + for I := 1 to M do + begin + // Shift columns after J up one place + for J := L to MN do X[I,J] := X[I,J+1]; + end; + for I := L to MN do + begin + // Shift rows after J up one place + for J := 1 to M do X[I,J] := X[I+1,J]; + end; + NIN[K] := NIN[K] + NIN[L]; + for I := L to MN do NIN[I] := NIN[I+1]; + goto label70; +label60: + // Update number of objects in each cluster + NIN[K] := NIN[K] + NIN[L]; +label70: // end of ARRANGE procedure + + // continuation of CLUSV1 procedure + // OUTPUT + if (CRIT = 0) then + begin + outline := format('Group %3d is joined by group %3d. N is %3d ITER := %3d SIM := %10.3f', + [NVAR[K], NVAR[L],NIN[K],ITR,RX]); + OutputFrm.RichEdit.Lines.Add(outline); + end else + begin + outline := format('Group %3d is joined by group %3d. N is %3d ITER := %3d DIS := %10.3f', + [NVAR[K], NVAR[L],NIN[K],ITR,RX]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + KLUS[ITR,1] := NVAR[K]; // save in KLUS rather than write out to file as in + KLUS[ITR,2] := NVAR[L]; // original program + if not(L = M) then + begin + MN := M - 1; + for i := L to MN do NVAR[i] := NVAR[i+1]; + end; + M := M - 1; + if (ITR < LIMIT) then goto label300; + OutputFrm.RichEdit.Lines.Add(''); +// OutputFrm.ShowModal; + // End of CLUSV1 procedure + + // do pre-tree processing + PreTree(nvalues, CRIT, LST, KLUS); + OutputFrm.ShowModal; + // do TREE procedure + TreePlot(KLUS,LST,nvalues); + OutputFrm.ShowModal; + + // cleanup + NVAR := nil; + NIN := nil; + LST := nil; + KLUS := nil; + X := nil; +end; + +procedure TAvgLinkFrm.TreePlot(Clusters : IntDyneMat; Lst : IntDyneVec; NoPoints : integer); +VAR + outline : array[0..501] of char; + aline : array[0..82] of char; + valstr : string; + tempstr : string; + plotline : string; + star : char; + blank : char; + col1, col2, colpos1, colpos2 : integer; + noparts, startcol, endcol : integer; + Results : StrDyneVec; + ColPos : IntDyneVec; + i, j, k, L, linecount, newcol, howlong, count: integer; + done : boolean; +begin + linecount := 1; + star := '*'; + blank := ' '; + SetLength(ColPos,NoPoints+2); + SetLength(Results,NoPoints*2+3); + OutputFrm.RichEdit.Lines.Add(''); + done := false; + // store initial column positions of vertical linkages + for i := 1 to NoPoints do ColPos[Lst[i]] := 4 + (i * 5); + + // create column heading indented 10 spaces + tempstr := 'UNIT '; + for i := 1 to NoPoints do + begin + valstr := format('%5d',[Lst[i]]); + tempstr := tempstr + valstr; + end; + Results[linecount] := tempstr; + linecount := linecount + 1; + + // create beginning of vertical linkages + plotline := 'STEP '; + for i := 1 to NoPoints do plotline := plotline + ' *'; + Results[linecount] := plotline; + linecount := linecount + 1; + + // start dendoplot + for i := 1 to NoPoints - 1 do + begin + outline := ''; + valstr := format('%5d',[i]); // put step no. first + outline := valstr; + // clear remainder of outline + for j := 5 to (5 + NoPoints * 5) do outline[j] := ' '; + outline[6 + NoPoints * 5] := #0; + col1 := Clusters[i,1]; + col2 := Clusters[i,2]; + // find column positions for each variable + colpos1 := ColPos[col1]; + colpos2 := ColPos[col2]; + + for k := colpos1 to colpos2 do outline[k] := star; + // change column positions 1/2 way between the matched ones + newcol := colpos1 + ((colpos2 - colpos1) div 2); + for k := 1 to NoPoints do + if ((ColPos[k] = colpos1) or (ColPos[k] = colpos2)) then ColPos[k] := newcol; + for k := 1 to NoPoints do + begin + L := ColPos[k]; + if ((L <> colpos1) and (L <> colpos2)) then outline[L] := star; + end; + Results[linecount] := outline; + linecount := linecount + 1; + + // add a line of connectors to next grouping + outline := ' '; + for j := 5 to (5 + NoPoints * 5) do outline[j] := blank; + for j := 1 to NoPoints do + begin + colpos1 := ColPos[j]; + outline[colpos1] := star; + end; + Results[linecount] := outline; + linecount := linecount + 1; + end; + + // output the Results in parts + // determine number of pages needed for whole plot + noparts := 0; + howlong := Length(Results[1]); + noparts := round(howlong / 80.0); + if (noparts <= 0) then noparts := 1; + + if (noparts = 1) then // simply print the list + begin + for i := 0 to linecount - 1 do + begin + OutputFrm.RichEdit.Lines.Add(Results[i]); + end; + end + else // break lines into strings of 15 units + begin + startcol := 0; + endcol := 80; + for i := 1 to noparts do + begin + outline := format('PART %d OUTPUT',[i]); + OutputFrm.RichEdit.Lines.Add(outline); + for j := 0 to 80 do aline[j] := blank; + + for j := 0 to linecount - 1 do + begin + count := 0; + outline := Results[j]; + for k := startcol to endcol do + begin + aline[count] := outline[k]; + count := count + 1; + end; + aline[count+1] := #0; + OutputFrm.RichEdit.Lines.Add(aline); + end; + OutputFrm.RichEdit.Lines.Add(''); + startcol := endcol + 1; + endcol := endcol + 80; + if (endcol > howlong) then endcol := howlong; + end; + end; + Results := nil; + ColPos := nil; +end; + +procedure TAvgLinkFrm.PreTree(NN, CRIT : integer; LST : IntDyneVec; KLUS : IntDyneMat); +VAR + I, II, J, NI, NJ, L, M, N, Ina, INEND, NHOLD, NLINES, INDX, ICOL, JCOL : integer; + KSH, JEND, MSH : integer; + JHOLD, NIN1 : IntDyneVec; + outline, outvalue : string; +label label2015, label2020, label2030, label2040, label2055, label2060; + +begin + // PRETRE procedure + SetLength(JHOLD,NN+1); + SetLength(NIN1,NN+1); +// int NN := nvalues; + N := NN - 1; + outline := format('No. of objects := %3d',[NN]); + OutputFrm.RichEdit.Lines.Add(outline); + if (CRIT = 0) then outline := 'Matrix defined similarities among objects.' + else outline := 'Matrix defined dissimilarities among objects.'; + OutputFrm.RichEdit.Lines.Add(outline); + + for I := 1 to NN do + begin + LST[I] := I; + NIN1[I] := 1; + end; + + for II := 1 to N do + begin + // name tabs + I := KLUS[II][1]; + J := KLUS[II][2]; + NI := NIN1[I]; + NJ := NIN1[J]; + L := 1; +label2015: + if (LST[L] = I) then goto label2020; + L := L + 1; + if (L <= NN) then goto label2015; +label2020: + ICOL := L; + Ina := ICOL + NI; + INEND := Ina + NJ - 1; + L := L + 1; +label2030: + if (LST[L] = J) then goto label2040; + L := L + 1; + if (L <= NN) then goto label2030; +label2040: + JCOL := L; + JEND := JCOL + NJ - 1; + NHOLD := 1; + + // remove J vector and store in HOLD + for M := JCOL to JEND do + begin + JHOLD[NHOLD] := LST[M]; + NHOLD := NHOLD + 1; + end; + + // shift + MSH := JEND; +label2055: + if (MSH = INEND) then goto label2060; + KSH := MSH - NJ; + LST[MSH] := LST[KSH]; + MSH := MSH - 1; + goto label2055; + + // insert hold vector +label2060: + NHOLD := 1; + for M := Ina to INEND do + begin + LST[M] := JHOLD[NHOLD]; + NHOLD := NHOLD + 1; + end; + NIN1[I] := NI + NJ; + end; + + NLINES := (NN div 20) + 1; + INDX := 0; + for I := 1 to NLINES do + begin + outline := ' '; + for J := 1 to 20 do + begin + INDX := INDX + 1; + if (INDX <= NN) then + begin + outvalue := format(' %3d',[LST[INDX]]); + outline := outline + outvalue; + end; + end; + end; + NIN1 := nil; + JHOLD := nil; + // End of PRETRE procedure +end; + +initialization + {$I avglinkunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multivariate/bartletttestunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/bartletttestunit.lfm new file mode 100644 index 000000000..e121d7074 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/bartletttestunit.lfm @@ -0,0 +1,340 @@ +object BartlettTestForm: TBartlettTestForm + Left = 474 + Height = 374 + Top = 304 + Width = 411 + AutoSize = True + Caption = 'Bartlett Test of Sphericity' + ClientHeight = 374 + ClientWidth = 411 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 106 + Height = 25 + Top = 341 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 172 + Height = 25 + Top = 341 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 4 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 246 + Height = 25 + Top = 341 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end + object HelpBtn: TButton + Tag = 119 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 43 + Height = 25 + Top = 341 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 2 + end + object Label5: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = DFEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 65 + Width = 88 + BorderSpacing.Left = 8 + Caption = 'Deg. Freedom = ' + ParentColor = False + end + object DFEdit: TEdit + AnchorSideLeft.Control = Label5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 104 + Height = 23 + Top = 61 + Width = 40 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 0 + Text = 'DFEdit' + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 334 + Height = 25 + Top = 341 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 6 + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 45 + Top = 8 + Width = 395 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'This is the Bartlett test of sphericity for three or more variables. Enter three or more of the variables listed in the left box and press the compute button to obtain the results.' + ParentColor = False + WordWrap = True + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 325 + Width = 411 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = DFEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 0 + Height = 241 + Top = 84 + Width = 411 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BevelOuter = bvNone + ClientHeight = 241 + ClientWidth = 411 + Constraints.MinHeight = 240 + TabOrder = 1 + object Label2: TLabel + AnchorSideTop.Control = Panel1 + Left = 8 + Height = 15 + Top = 8 + Width = 46 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = ChiSqrEdit + Left = 8 + Height = 185 + Top = 25 + Width = 166 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object Label3: TLabel + AnchorSideLeft.Control = SelList + AnchorSideTop.Control = Label2 + Left = 236 + Height = 15 + Top = 8 + Width = 44 + Caption = 'Selected' + ParentColor = False + end + object SelList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ProbEdit + Left = 236 + Height = 185 + Top = 25 + Width = 167 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + TabOrder = 4 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 191 + Height = 26 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 191 + Height = 26 + Top = 55 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = OutBtn + AnchorSideTop.Side = asrBottom + Left = 182 + Height = 25 + Top = 85 + Width = 46 + AutoSize = True + BorderSpacing.Top = 4 + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 3 + end + object Label1: TLabel + AnchorSideTop.Control = ChiSqrEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ChiSqrEdit + Left = 19 + Height = 15 + Top = 222 + Width = 67 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Chisquare = ' + ParentColor = False + end + object ChiSqrEdit: TEdit + AnchorSideRight.Control = VarList + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 94 + Height = 23 + Top = 218 + Width = 80 + Alignment = taRightJustify + Anchors = [akRight, akBottom] + TabOrder = 5 + Text = 'ChiSqrEdit' + end + object Label4: TLabel + AnchorSideTop.Control = ProbEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ProbEdit + Left = 252 + Height = 15 + Top = 222 + Width = 71 + Anchors = [akTop, akRight] + Caption = 'Probability = ' + ParentColor = False + end + object ProbEdit: TEdit + AnchorSideRight.Control = SelList + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 323 + Height = 23 + Top = 218 + Width = 80 + Alignment = taRightJustify + Anchors = [akRight, akBottom] + TabOrder = 6 + Text = 'ProbEdit' + end + end +end diff --git a/applications/lazstats/source/forms/analysis/multivariate/bartletttestunit.pas b/applications/lazstats/source/forms/analysis/multivariate/bartletttestunit.pas new file mode 100644 index 000000000..3e2fd0cb3 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/bartletttestunit.pas @@ -0,0 +1,245 @@ +unit BartlettTestUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, FunctionsLib, OutputUnit, DataProcs, + MatrixLib, ContextHelpUnit; + +type + + { TBartlettTestForm } + + TBartlettTestForm = class(TForm) + AllBtn: TBitBtn; + Bevel1: TBevel; + Memo1: TLabel; + Panel1: TPanel; + ReturnBtn: TButton; + CancelBtn: TButton; + ChiSqrEdit: TEdit; + DFEdit: TEdit; + Label5: TLabel; + ProbEdit: TEdit; + HelpBtn: TButton; + InBtn: TBitBtn; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + ComputeBtn: TButton; + OutBtn: TBitBtn; + ResetBtn: TButton; + SelList: TListBox; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + BartlettTestForm: TBartlettTestForm; + +implementation + +uses + Math; + +{ TBartlettTestForm } + +procedure TBartlettTestForm.ResetBtnClick(Sender: TObject); +VAR i :integer; +begin + ChiSqrEdit.Text := ''; + ProbEdit.Text := ''; + DFEdit.Text := ''; + InBtn.Enabled := true; + OutBtn.Enabled := false; + VarList.Clear; + SelList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TBartlettTestForm.InBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + SelList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + OutBtn.Enabled := true; +end; + +procedure TBartlettTestForm.AllBtnClick(Sender: TObject); +VAR i : integer; +begin + for i := 0 to VarList.Items.Count-1 do + SelList.Items.Add(VarList.Items.Strings[i]); + VarList.Clear; + OutBtn.Enabled := true; + InBtn.Enabled := false; +end; + +procedure TBartlettTestForm.ComputeBtnClick(Sender: TObject); +VAR + matrix, temp, eigenvectors : DblDyneMat; + eigenvalues, means, variances, stddevs : DblDyneVec; + determinant, chisquare, probability, natlogp : double; + i, j, df, p, ncases, colno : integer; + aline, strvalue, ytitle, title, probvalue, chivalue : string; + ColNoSelected : IntDyneVec; + dblvalue : double; + DataGrid : DblDyneMat; + RowLabels, ColLabels : StrDyneVec; + errorcode : boolean; +begin + p := SelList.Count; + SetLength(matrix,p+1,p+1); + SetLength(temp,p+1,p+1); + SetLength(eigenvectors,p,p); + SetLength(eigenvalues,p); + SetLength(means,p+1); + SetLength(stddevs,p+1); + SetLength(variances,p+1); + SetLength(ColNoSelected,p+1); + SetLength(DataGrid,NoCases,p+1); + SetLength(RowLabels,p+1); + SetLength(ColLabels,p+1); + + for j := 0 to p-1 do + begin + for i := 1 to NoVariables do + begin + if SelList.Items.Strings[j] = OS3MainFrm.DataGrid.Cells[i,0] then + begin + ColNoSelected[j] := i; + RowLabels[j] := OS3MainFrm.DataGrid.Cells[i,0]; + ColLabels[j] := OS3MainFrm.DataGrid.Cells[i,0]; + end; + end; + end; + ncases := 0; + ytitle := 'Variable'; + errorcode := false; + + // get data into the datagrid + for j := 0 to p-1 do + begin + for i := 1 to NoCases do + begin + if not GoodRecord(i,p,ColNoSelected) then continue; + colno := ColNoSelected[j]; + dblvalue := StrToFloat(OS3MainFrm.DataGrid.Cells[colno,i]); + DataGrid[i-1,j] := dblvalue; + ncases := ncases + 1; + end; + end; + OutputFrm.RichEdit.Clear; + ncases := 0; + Correlations(p,ColNoSelected,matrix,means,variances,stddevs,errorcode,ncases); + title := 'CORRELATION MATRIX'; + MAT_PRINT(matrix,p,p,title,RowLabels,ColLabels,ncases); + OutputFrm.RichEdit.Lines.Add(''); + DETERM(matrix,p,p,determinant,errorcode); + strvalue := format('Determinant of matrix = %8.3f',[determinant]); + OutputFrm.RichEdit.Lines.Add(strvalue); + OutputFrm.RichEdit.Lines.Add(''); + natlogp := ln(1.0 / p); + chisquare := -((ncases-1) - (2.0*p-5)/6) * ln(determinant); + df := ((p * p) - p) div 2; + probability := chisquaredprob(chisquare,df); + chivalue := format('%8.3f',[chisquare]); + probvalue := format('%8.3f',[1.0-probability]); + chisqrEdit.Text := chivalue; + ProbEdit.Text := probvalue; + DFEdit.Text := IntToStr(df); + aline := format('chisquare = %s, D.F. = %D, Proabability greater value = %s', + [chivalue,df,probvalue]); + OutputFrm.RichEdit.Lines.Add(aline); + ColLabels := nil; + RowLabels := nil; + DataGrid := nil; + ColNoSelected := nil; + variances := nil; + stddevs := nil; + means := nil; + eigenvalues := nil; + eigenvectors := nil; + temp := nil; + matrix := nil; + OutputFrm.ShowModal; +end; + +procedure TBartlettTestForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + Constraints.MinHeight := Height; + Constraints.MinWidth := Width; + + FAutoSized := true; +end; + +procedure TBartlettTestForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TBartlettTestForm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TBartlettTestForm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := SelList.ItemIndex; + VarList.Items.Add(SelList.Items.Strings[index]); + SelList.Items.Delete(index); + InBtn.Enabled := true; + if SelList.Items.Count = 0 then OutBtn.Enabled := false; + +end; + +initialization + {$I bartletttestunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multivariate/correspondenceunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/correspondenceunit.lfm new file mode 100644 index 000000000..0b69601db --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/correspondenceunit.lfm @@ -0,0 +1,448 @@ +object CorrespondenceForm: TCorrespondenceForm + Left = 502 + Height = 536 + Top = 206 + Width = 562 + AutoSize = True + Caption = 'Correspondence Analysis' + ClientHeight = 536 + ClientWidth = 562 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 177 + Top = 310 + Width = 546 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 7 + ClientHeight = 157 + ClientWidth = 542 + TabOrder = 1 + object ObsChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 258 + AutoSize = False + Caption = 'Show Observed Frequencies' + TabOrder = 0 + end + object PropsChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 258 + Caption = 'Show Row and Col. Proportions' + TabOrder = 1 + end + object ExpChk: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 258 + Caption = 'Show Expected Frequencies' + TabOrder = 2 + end + object ChiChk: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 258 + Caption = 'Show Cell Chi-square values' + TabOrder = 3 + end + object YatesChk: TCheckBox + Left = 12 + Height = 19 + Top = 90 + Width = 258 + Caption = 'Use Yate''s Correction for 2x2 table' + TabOrder = 4 + end + object ShowQChk: TCheckBox + Left = 12 + Height = 19 + Top = 111 + Width = 258 + Caption = 'Show Q Matrix' + TabOrder = 5 + end + object QCheckChk: TCheckBox + Left = 12 + Height = 19 + Top = 132 + Width = 258 + Caption = 'Check that Q = UDV' + TabOrder = 6 + end + object EigenChk: TCheckBox + Left = 270 + Height = 19 + Top = 6 + Width = 260 + Caption = 'Values and Vectors of UDV''' + TabOrder = 7 + end + object ShowABChk: TCheckBox + Left = 270 + Height = 19 + Top = 27 + Width = 260 + Caption = 'A, B of Generalized SVD' + TabOrder = 8 + end + object CheckPChk: TCheckBox + Left = 270 + Height = 19 + Top = 48 + Width = 260 + Caption = 'Check P is reproduced by ADB''' + TabOrder = 9 + end + object RowCorres: TCheckBox + Left = 270 + Height = 19 + Top = 69 + Width = 260 + Caption = 'Row Correspondence' + TabOrder = 10 + end + object ColCorrChk: TCheckBox + Left = 270 + Height = 19 + Top = 90 + Width = 260 + Caption = 'Column Correspondence' + TabOrder = 11 + end + object BothCorrChk: TCheckBox + Left = 270 + Height = 19 + Top = 111 + Width = 260 + Caption = 'Row and Column Correspondence' + Checked = True + State = cbChecked + TabOrder = 12 + end + object PlotChk: TCheckBox + Left = 270 + Height = 19 + Top = 132 + Width = 260 + Caption = 'Plot Weights' + Checked = True + State = cbChecked + TabOrder = 13 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 261 + Height = 25 + Top = 503 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 327 + Height = 25 + Top = 503 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 4 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 401 + Height = 25 + Top = 503 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 489 + Height = 25 + Top = 503 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 6 + end + object HelpBtn: TButton + Tag = 160 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 198 + Height = 25 + Top = 503 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 2 + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 105 + Top = 8 + Width = 546 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Directions: Your data grid should consist of a table of N rows and M+1 variables with N >= to M. Each row should have a label variable and M columns of data (integer frequencies. An example is in a file labeled "Smokers.LAZ".'#13#10'1. Enter the variable for the row labels defined as a string-type of variable.'#13#10'2. Enter the variables representing the M columns of data as integer-type of variables.'#13#10'3. Click on the options desired.'#13#10'4. Click the Compute button.' + ParentColor = False + WordWrap = True + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 487 + Width = 562 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 0 + Height = 189 + Top = 113 + Width = 562 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 189 + ClientWidth = 562 + TabOrder = 0 + object Label1: TLabel + AnchorSideTop.Control = Panel1 + Left = 8 + Height = 15 + Top = 12 + Width = 49 + BorderSpacing.Top = 12 + Caption = 'Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ColIn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 160 + Top = 29 + Width = 251 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object RowIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 267 + Height = 28 + Top = 29 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = RowInClick + Spacing = 0 + TabOrder = 1 + end + object RowOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = RowIn + AnchorSideTop.Side = asrBottom + Left = 267 + Height = 28 + Top = 59 + Width = 28 + BorderSpacing.Top = 2 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = RowOutClick + Spacing = 0 + TabOrder = 2 + end + object ColIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = RowOut + AnchorSideTop.Side = asrBottom + Left = 267 + Height = 28 + Top = 127 + Width = 28 + BorderSpacing.Top = 40 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ColInClick + Spacing = 0 + TabOrder = 4 + end + object ColOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ColIn + AnchorSideTop.Side = asrBottom + Left = 267 + Height = 28 + Top = 159 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ColOutClick + Spacing = 0 + TabOrder = 5 + end + object Label2: TLabel + AnchorSideLeft.Control = RowEdit + AnchorSideTop.Control = Label1 + AnchorSideBottom.Control = RowEdit + Left = 303 + Height = 15 + Top = 35 + Width = 98 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Row Label Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = ColList + AnchorSideBottom.Control = ColList + Left = 303 + Height = 15 + Top = 110 + Width = 95 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Column Variables:' + ParentColor = False + end + object RowEdit: TEdit + AnchorSideLeft.Control = RowIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = RowOut + AnchorSideBottom.Side = asrBottom + Left = 303 + Height = 23 + Top = 52 + Width = 232 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 3 + Text = 'RowEdit' + end + object ColList: TListBox + AnchorSideLeft.Control = ColIn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ColIn + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 303 + Height = 62 + Top = 127 + Width = 232 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 6 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/multivariate/correspondenceunit.pas b/applications/lazstats/source/forms/analysis/multivariate/correspondenceunit.pas new file mode 100644 index 000000000..5fcbce079 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/correspondenceunit.pas @@ -0,0 +1,1062 @@ +unit CorrespondenceUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, FunctionsLib, OutputUnit, ContextHelpUnit, MatrixLib, BlankFrmUnit; + +type + + { TCorrespondenceForm } + + TCorrespondenceForm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Memo1: TLabel; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + ObsChk: TCheckBox; + CheckPChk: TCheckBox; + RowCorres: TCheckBox; + ColCorrChk: TCheckBox; + BothCorrChk: TCheckBox; + PlotChk: TCheckBox; + PropsChk: TCheckBox; + ExpChk: TCheckBox; + ChiChk: TCheckBox; + YatesChk: TCheckBox; + ShowQChk: TCheckBox; + QCheckChk: TCheckBox; + EigenChk: TCheckBox; + ShowABChk: TCheckBox; + ColList: TListBox; + GroupBox1: TGroupBox; + RowEdit: TEdit; + RowIn: TBitBtn; + ColIn: TBitBtn; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + RowOut: TBitBtn; + ColOut: TBitBtn; + VarList: TListBox; + procedure ColInClick(Sender: TObject); + procedure ColOutClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure plotxy(Xpoints, Ypoints : DblDyneVec; Xmax, Xmin, Ymax, + Ymin : double; N : integer; + PtLabels : StrDyneVec; titlestr, + Xlabel, Ylabel : string); + procedure RowInClick(Sender: TObject); + procedure RowOutClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + CorrespondenceForm: TCorrespondenceForm; + +implementation + +uses + Math; + +{ TCorrespondenceForm } + +procedure TCorrespondenceForm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + ColList.Clear; + RowEdit.Text := ''; + RowIn.Enabled := true; + RowOut.Enabled := false; + ColIn.Enabled := true; + ColOut.Enabled := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TCorrespondenceForm.ColInClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while (i < index) do + begin + if (VarList.Selected[i]) then + begin + ColList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + ColOut.Enabled := true; +end; + +procedure TCorrespondenceForm.ColOutClick(Sender: TObject); +VAR index : integer; +begin + index := ColList.ItemIndex; + if (index < 0) then + begin + ColOut.Enabled := false; + exit; + end; + VarList.Items.Add(ColList.Items.Strings[index]); + ColList.Items.Delete(index); +end; + +procedure TCorrespondenceForm.ComputeBtnClick(Sender: TObject); +VAR + i, j, RowNo: integer; + Row, Col, Ncases, Nrows, Ncols, df : integer; + RowLabels, ColLabels : StrDyneVec; + ColNoSelected : IntDyneVec; + cellstring, outline, title: string; + prompt, xtitle, ytitle : string; + Freq : IntDyneMat; + Prop, Expected, CellChi : DblDyneMat; + ChiSquare, ProbChi, liklihood, probliklihood : double; + SumX, SumY, VarX, VarY, MantelHaenszel, MHprob : double; + yates : boolean; + Adjchisqr, Adjprobchi, phi, pearsonr : double; + IX, IY : integer; + CoefCont, CramerV : double; + + Trans : DblDyneMat; // transpose work matrix + P : DblDyneMat; // relative frequencies (n by q correspondence matrix) + r : DblDyneVec; // row vector of proportions + c : DblDyneVec; // column vector of proportions + Dr : DblDyneMat; // Diagonal matrix of row proportions + Dc : DblDyneMat; // Diagonal matric of column proportions + A : DblDyneMat; // n by q matrix whose columns are theleft generalized SVD vectors + Du : DblDyneMat; // q by q diagonal matrix of singular values + B : DblDyneMat; // m by q matrix whose columns are the right generalized SVD vectors + Q : DblDyneMat; // matrix to be decomposed by SVD into U x Da x V' + U : DblDyneMat; // left column vectors of SVD of Q + V : DblDyneMat; // right vectors of SVD of Q + W : DblDyneMat; // work matrix for transposing a matrix + F : DblDyneMat; // Row Coordinates + Gc : DblDyneMat; // Column Coordinates + n, q1: integer; // number of rows and columns of the P matrix + largest :integer; + X, Y : DblDyneVec; + Xmax, Xmin, Ymax, Ymin, Inertia : double; + labels : StrDyneVec; + errorcode : boolean = false; + +begin + SetLength(ColNoSelected,NoVariables+1); + yates := false; + RowNo := 0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = RowEdit.Text) then RowNo := i; + end; + Nrows := NoCases; + Ncols := ColList.Items.Count; + SetLength(RowLabels,Nrows+1); + SetLength(ColLabels,Ncols+1); + + if (RowNo = 0) then + begin + ShowMessage('ERROR! A variable for the row labels was not entered.'); + ColNoSelected := nil; + RowLabels := nil; + ColLabels := nil; + exit; + end; + ColNoSelected[0] := RowNo; + + // Get Column labels + for i := 0 to Ncols-1 do + begin + ColLabels[i] := ColList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[j,0]; + if (cellstring = ColLabels[i])then ColNoSelected[i+1] := j; + end; + end; + + // Get row labels + for i := 1 to NoCases do + begin + RowLabels[i-1] := OS3MainFrm.DataGrid.Cells[RowNo,i]; + end; + + // allocate and initialize + SetLength(Freq,Nrows+1,Ncols+1); + SetLength(Prop,Nrows+1,Ncols+1); + SetLength(Expected,Nrows,Ncols); + SetLength(CellChi,Nrows,Ncols); + for i := 1 to Nrows + 1 do + for j := 1 to Ncols + 1 do Freq[i-1,j-1] := 0; + RowLabels[Nrows] := 'Total'; + ColLabels[Ncols] := 'Total'; + + // get cell data + Ncases := 0; + for i := 1 to NoCases do + begin + Row := i; + for j := 1 to Ncols do + begin + Col := ColNoSelected[j]; + Freq[i-1,j-1] := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[Col,Row]))); + Ncases := Ncases + Freq[i-1,j-1]; + end; + end; + Freq[Nrows,Ncols] := Ncases; + + // Now, calculate expected values + // Get row totals first + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + Freq[i-1,Ncols] := Freq[i-1,Ncols] + Freq[i-1,j-1]; + end; + end; + // Get col totals next + for j := 1 to Ncols do + begin + for i := 1 to Nrows do + begin + Freq[Nrows,j-1] := Freq[Nrows,j-1] + Freq[i-1,j-1]; + end; + end; + + // Then get expected values and cell chi-squares + ChiSquare := 0.0; + Adjchisqr := 0.0; + if ((YatesChk.Checked) and (Nrows = 2) and (Ncols = 2)) then yates := true; + if ((Nrows > 1) and (Ncols > 1)) then + begin + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + Expected[i-1,j-1] := Freq[Nrows,j-1] * Freq[i-1,Ncols] / Ncases; + if (Expected[i-1,j-1] > 0.0) then + CellChi[i-1,j-1] := sqr(Freq[i-1,j-1] - Expected[i-1,j-1]) / Expected[i-1,j-1] + else + begin + ShowMessage('ERROR! Zero expected value found.'); + CellChi[i-1,j-1] := 0.0; + end; + ChiSquare := ChiSquare + CellChi[i-1,j-1]; + end; + end; + df := (Nrows - 1) * (Ncols - 1); + if (yates = true) then // 2 x 2 corrected chi-square + begin + Adjchisqr := abs((Freq[0,0] * Freq[1,1]) - (Freq[0,1] * Freq[1,0])); + Adjchisqr := sqr(Adjchisqr - Ncases / 2.0) * Ncases; // numerator + Adjchisqr := Adjchisqr / (Freq[0,2] * Freq[1,2] * Freq[2,0] * Freq[2,1]); + Adjprobchi := 1.0 - chisquaredprob(Adjchisqr,df); + end; + end; + if (Nrows = 1) then // equal probability + begin + for j := 0 to Ncols - 1 do + begin + Expected[0,j] := Ncases / Ncols; + if (Expected[0,j] > 0) then + CellChi[0,j] := sqr(Freq[0,j] - Expected[0,j]) / Expected[0,j]; + ChiSquare := ChiSquare + CellChi[0,j]; + end; + df := Ncols - 1; + end; + + if (Ncols = 1) then // equal probability + begin + for i := 0 to Nrows - 1 do + begin + Expected[i,0] := Ncases / Nrows; + if (Expected[i,0] > 0) then + CellChi[i,0] := sqr(Freq[i,0] - Expected[i,0]) / Expected[i,0]; + ChiSquare := ChiSquare + CellChi[i,0]; + end; + df := Nrows - 1; + end; + + ProbChi := 1.0 - chisquaredprob(ChiSquare,df); // prob. larger chi + + // Print acknowledgements + OutputFrm.RichEdit.Lines.Add('CORRESPONDENCE ANALYSIS'); + OutputFrm.RichEdit.Lines.Add('Based on formulations of Bee-Leng Lee'); + OutputFrm.RichEdit.Lines.Add('Chapter 11 Correspondence Analysis for ViSta'); + OutputFrm.RichEdit.Lines.Add('Results are based on the Generalized Singular Value Decomposition'); + OutputFrm.RichEdit.Lines.Add('of P := A x D x B where P is the relative frequencies observed,'); + OutputFrm.RichEdit.Lines.Add('A are the left generalized singular vectors,'); + OutputFrm.RichEdit.Lines.Add('D is a diagonal matrix of generalized singular values, and'); + OutputFrm.RichEdit.Lines.Add('B is the transpose of the right generalized singular vectors.'); + OutputFrm.RichEdit.Lines.Add('NOTE: The first value and corresponding vectors are 1 and are'); + OutputFrm.RichEdit.Lines.Add('to be ignored.'); + OutputFrm.RichEdit.Lines.Add('An intermediate step is the regular SVD of the matrix Q := UDV'); + OutputFrm.RichEdit.Lines.Add('where Q := Dr^-1/2 x P x Dc^-1/2 where Dr is a diagonal matrix'); + OutputFrm.RichEdit.Lines.Add('of total row relative frequencies and Dc is a diagonal matrix'); + OutputFrm.RichEdit.Lines.Add('of total column relative frequencies.'); + OutputFrm.ShowModal; + + //Print results to output form + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Chi-square Analysis Results'); + outline := format('No. of Cases := %d',[Ncases]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + // print tables requested by use + if (ObsChk.Checked) then + begin + IntArrayPrint(Freq, Nrows+1, Ncols+1,'Frequencies', + RowLabels, ColLabels,'OBSERVED FREQUENCIES'); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + end; + + if (ExpChk.Checked)then + begin + outline := 'EXPECTED FREQUENCIES'; + MAT_PRINT(Expected, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + outline := 'ROW PROPORTIONS'; + for i := 1 to Nrows + 1 do + begin + for j := 1 to Ncols do + begin + if (Freq[i-1,Ncols] > 0.0) then + Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[i-1,Ncols] + else Prop[i-1,j-1] := 0.0; + end; + if (Freq[i-1,Ncols] > 0.0) then Prop[i-1,Ncols] := 1.0 + else Prop[i-1,Ncols] := 0.0; + end; + if (PropsChk.Checked) then + begin + MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + outline := 'COLUMN PROPORTIONS'; + for j := 1 to Ncols + 1 do + begin + for i := 1 to Nrows do + begin + if (Freq[Nrows,j-1] > 0.0) then + Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[Nrows,j-1] + else Prop[i-1,j-1] := 0.0; + end; + if (Freq[Nrows,j-1] > 0.0) then Prop[Nrows,j-1] := 1.0 + else Prop[Nrows,j-1] := 0.0; + end; + if (PropsChk.Checked) then + begin + MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + outline := 'PROPORTIONS OF TOTAL N'; + for i := 1 to Nrows + 1 do + for j := 1 to Ncols + 1 do Prop[i-1,j-1] := Freq[i-1,j-1] / Ncases; + Prop[Nrows,Ncols] := 1.0; + MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + if (ChiChk.Checked) then + begin + outline := 'CHI-SQUARED VALUE FOR CELLS'; + MAT_PRINT(CellChi, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Chi-square := %8.3f with D.F. := %d. Prob. > value := %8.3f',[ChiSquare,df,ProbChi]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + if (yates = true) then + begin + outline := format('Chi-square using Yates correction = %8.3f and Prob > value := %8.3f', + [Adjchisqr,Adjprobchi]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + + liklihood := 0.0; + for i := 0 to Nrows - 1 do + for j := 0 to Ncols - 1 do + if (Freq[i,j] > 0.0) then liklihood := liklihood + Freq[i,j] * (ln(Expected[i,j] / Freq[i,j])); + liklihood := -2.0 * liklihood; + probliklihood := 1.0 - chisquaredprob(liklihood,df); + outline := format('Liklihood Ratio := %8.3f with prob. > value := %6.4f',[liklihood,probliklihood]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + if ((Nrows > 1) and (Ncols > 1)) then + begin + phi := sqrt(ChiSquare / Ncases); + outline := format('phi correlation := %6.4f',[phi]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + pearsonr := 0.0; + SumX := 0.0; + SumY := 0.0; + VarX := 0.0; + VarY := 0.0; + for i := 0 to Nrows - 1 do SumX := SumX + ( (i+1) * Freq[i,Ncols] ); + for j := 0 to Ncols - 1 do SumY := SumY +( (j+1) * Freq[Nrows,j] ); + for i := 0 to Nrows - 1 do VarX := VarX + ( ((i+1)*(i+1)) * Freq[i,Ncols] ); + for j := 0 to Ncols - 1 do VarY := VarY +( ((j+1)*(j+1)) * Freq[Nrows,j] ); + VarX := VarX - ((SumX * SumX) / Ncases); + VarY := VarY - ((SumY * SumY) / Ncases); + for i := 0 to Nrows - 1 do + for j := 0 to Ncols - 1 do + pearsonr := pearsonr + ((i+1)*(j+1) * Freq[i,j]); + pearsonr := pearsonr - (SumX * SumY / Ncases); + pearsonr := pearsonr / sqrt(VarX * VarY); + outline := format('Pearson Correlation r := %6.4f',[pearsonr]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + MantelHaenszel := (Ncases-1) * (pearsonr * pearsonr); + MHprob := 1.0 - chisquaredprob(MantelHaenszel,1); + outline := format('Mantel-Haenszel Test of Linear Association := %8.3f with probability > value := %6.4f', + [MantelHaenszel, MHprob]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + CoefCont := sqrt(ChiSquare / (ChiSquare + Ncases)); + outline := format('The coefficient of contingency := %8.3f',[CoefCont]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + if (Nrows < Ncols) then CramerV := sqrt(ChiSquare / (Ncases * (Nrows-1))) + else CramerV := sqrt(ChiSquare / (Ncases * ((Ncols-1)))); + outline := format('Cramers V := %8.3f',[CramerV]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + n := Nrows; + q1 := Ncols; + if (n > q1) then largest := n + else largest := q1; + SetLength(P,n,q1); + SetLength(r,largest+1); + SetLength(c,q1); + SetLength(Dr,n,n); + SetLength(Dc,q1,q1); + SetLength(A,n,q1); + SetLength(Du,largest,largest); + SetLength(B,n,q1); + SetLength(Q,n,q1); + SetLength(U,n,n); + SetLength(V,q1,q1); + SetLength(W,largest+1,largest+1); + SetLength(Trans,q1,q1); + SetLength(F,n,q1); + SetLength(Gc,q1,q1); + + // get proportion matices and vectors + for i := 0 to n - 1 do + for j := 0 to q1 - 1do P[i,j] := Prop[i,j]; + for i := 0 to n - 1 do r[i] := Prop[i,q1]; + for j := 0 to q1 - 1 do c[j] := Prop[n,j]; + + // get Dr^-1/2 and Dc^-1/2 + for i := 0 to n - 1 do + begin + for j := 0 to n - 1 do + begin + if (i <> j) then Dr[i,j] := 0.0 + else Dr[i,j] := 1.0 / sqrt(r[i]); + end; + end; + for i := 0 to q1 - 1 do + begin + for j := 0 to q1 -1 do + begin + if (i <> j) then Dc[i,j] := 0.0 + else Dc[i,j] := 1.0 / sqrt(c[j]); + end; + end; + + // get q1 := Dr^-1/2 times P times Dc^-1/2 + MATAxB(W,Dr,P,n,n,n,q1,errorcode); + MATAxB(q,W,Dc,n,q1,q1,q1,errorcode); + if (ShowqChk.Checked) then + begin + outline := 'Q Matrix'; + MAT_PRINT(q,n,q1,outline,RowLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; +(* + Instr := InputBox('Save q1 to Main Grid?','Y','N'); + if (Instr = 'Y') then + begin + OS3MainFrm.CloseFileBtnClick(self); + OS3MainFrm.DataGrid.RowCount := n + 1; + OS3MainFrm.DataGrid.ColCount := q1 + 1; + for i := 0 to n - 1 do + for j := 0 to q1 - 1 do + OS3MainFrm.DataGrid.Cells[j+1,i+1] := q1[i,j]; + for i := 1 to n do + OS3MainFrm.DataGrid.Cells[0,i] := 'CASE ' + IntToStr(i); + for j := 1 to q1 do + OS3MainFrm.DataGrid.Cells[j,0] := 'VAR' + IntToStr(j); + end; + end; +*) + //Obtain ordinary SVD analysis of q1 + matinv(q,U,Du,V,q1); + + if (EigenChk.Checked) then + begin + outline := 'U Matrix'; + MAT_PRINT(U,n,q1,outline,RowLabels,ColLabels,NoCases); + outline := 'Singular Values'; + MAT_PRINT(Du,q1,q1,outline,ColLabels,ColLabels,NoCases); + outline := 'V Matrix'; + MAT_PRINT(V,q1,q1,outline,ColLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + if (qCheckChk.Checked) then + begin + // Check to see if q1 is reproduced by U x D x V' + MATAxB(W,U,Du,n,q1,q1,q1,errorcode); + for i := 0 to q1 - 1 do + for j := 0 to q1 - 1 do Trans[i,j] := V[j,i]; + MATAxB(q,W,Trans,n,q1,q1,q1,errorcode); + outline := 'Reproduced Q = UDV'; + MAT_PRINT(q,n,q1,outline,RowLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + // Get A := Dr^1/2 times U + for i := 0 to n - 1 do + begin + for j := 0 to n - 1 do + begin + if (i <> j) then Dr[i,j] := 0.0 + else Dr[i,j] := sqrt(r[i]); + end; + end; + MATAxB(A,Dr,U,n,n,n,q1,errorcode); + if (ShowABChk.Checked) then + begin + outline := 'A Matrix'; + MAT_PRINT(A,n,q1,outline,RowLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + // Get B := Dc^1/2 times V + for i := 0 to q1 - 1 do + begin + for j := 0 to q1-1 do + begin + if (i <> j) then Dc[i,j] := 0.0 + else Dc[i,j] := sqrt(c[j]); + end; + end; + MATAxB(B,Dc,V,q1,q1,q1,q1,errorcode); + if (ShowABChk.Checked) then + begin + outline := 'B Matrix'; + MAT_PRINT(B,q1,q1,outline,ColLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + if (CheckPChk.Checked) then + begin // see if P := A x Du x B' + for i := 0 to q1 - 1 do + for j := 0 to q1 - 1 do Trans[j,i] := B[i,j]; + MATAxB(W,A,Du,n,q1,q1,q1,errorcode); + MATAxB(P,W,Trans,n,q1,q1,q1,errorcode); + outline := 'P = '; + MAT_PRINT(P,n,q1,outline,RowLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + // show intertia and scree plot + Inertia := ChiSquare / Freq[Nrows,Ncols]; + outline := format('Inertia := %8.4f',[Inertia]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + if (PlotChk.Checked) then + begin + SetLength(X,n); + SetLength(Y,n); + SetLength(labels,q1); + Xmax := -10000.0; + Ymax := Xmax; + Xmin := 10000.0; + Ymin := Xmin; + X[0] := 1; + Y[0] := sqr(Du[1,1]); + for i := 1 to q1 - 1 do + begin + X[i] := i; + Y[i] := sqr(Du[i,i]); + outline := format('%4.3f%',[(Y[i] / Inertia)*100.0]); + labels[i] := outline; // 'Dim.' + IntToStr(i); + if (X[i] > Xmax) then Xmax := X[i]; + if (X[i] < Xmin) then Xmin := X[i]; + if (Y[i] > Ymax) then Ymax := Y[i]; + if (Y[i] < Ymin) then Ymin := Y[i]; + end; + title := 'Goodness of Fit Plot'; + plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,q1,labels, title,'Dimension',' '); + BlankFrm.ShowModal; + labels := nil; + Y := nil; + X := nil; + end; + +// if (RowCorres.Checked)then +// begin + // Get Row coordinates F (for row profile analysis) + for i := 0 to n - 1 do + begin + for j := 0 to n - 1 do + begin + if (i <> j) then Dr[i,j] := 0.0 + else Dr[i,j] := 1.0 / r[i]; + end; + end; + MATAxB(W,Dr,A,n,n,n,q1,errorcode); +// ArrayPrint(W,n,q1,'Dr x A matrix',RowLabels,ColLabels,'Dr x A Matrix'); +// FrmOutPut.ShowModal; + MATAxB(F,W,Du,n,q1,q1,q1,errorcode); + if (RowCorres.Checked) then + begin + outline := 'Row Dimensions (Ignore Col. 1'; + MAT_PRINT(F,n,q1,outline,RowLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + // Get Column coordinates G (row profile analysis) + for i := 0 to q1 - 1 do + begin + for j := 0 to q1 - 1 do + begin + if (i <> j) then Dc[i,j] := 0.0 + else Dc[i,j] := 1.0 / c[j]; + end; + end; + MATAxB(Gc,Dc,B,q1,q1,q1,q1,errorcode); + if (RowCorres.Checked) then + begin + outline := 'Col. Dimensions (Ignore Col. 1'; + MAT_PRINT(Gc,q1,q1,outline,ColLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + if ((PlotChk.Checked) and (RowCorres.Checked))then + begin + prompt := InputBox('X Axis Dimension','1','1'); + IX := StrToInt(prompt); + prompt := InputBox('Y Axis Dimension','2','2'); + IY := StrToInt(prompt); + xtitle := 'Dimension ' + IntToStr(IX); + ytitle := 'Dimension ' + IntToStr(IY); + SetLength(X,n); + SetLength(Y,n); + Xmax := -10000.0; + Ymax := Xmax; + Xmin := 10000.0; + Ymin := Xmin; + for i := 0 to n - 1 do + begin + X[i] := F[i,IX]; + if (X[i] > Xmax) then Xmax := X[i]; + if (X[i] < Xmin) then Xmin := X[i]; + Y[i] := F[i,IY]; + if (Y[i] > Ymax) then Ymax := Y[i]; + if (Y[i] < Ymin) then Ymin := Y[i]; + end; + title := 'Row Dimensions'; + plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,n,RowLabels, title,xtitle,ytitle); + BlankFrm.ShowModal; + Y := nil; + X := nil; + SetLength(X,q1); + SetLength(Y,q1); + Xmax := -10000.0; + Ymax := Xmax; + Xmin := 10000.0; + Ymin := Xmin; + for i := 0 to q1 - 1 do + begin + X[i] := Gc[i,IX]; + if (X[i] > Xmax) then Xmax := X[i]; + if (X[i] < Xmin) then Xmin := X[i]; + Y[i] := Gc[i,IY]; + if (Y[i] > Ymax) then Ymax := Y[i]; + if (Y[i] < Ymin) then Ymin := Y[i]; + end; + title := 'Column Dimensions'; + plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,q1,ColLabels, title,xtitle,ytitle); + BlankFrm.ShowModal; + Y := nil; + X := nil; + end; +// end; + + // do column correspondence analysis if checked +// if (ColCorrChk.Checked) then +// begin + for i := 0 to q1 - 1 do + for j := 0 to q1 - 1 do W[i,j] := Gc[i,j]; // use last Gc + MATAxB(Gc,W,Du,q1,q1,q1,q1,errorcode); // multiply times Du + if (ColCorrChk.Checked) then + begin + outline := 'Column Dimensions (Ignore Col. 1'; + MAT_PRINT(Gc,q1,q1,outline,ColLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + end; + MATAxB(F,Dr,A,n,n,n,q1,errorcode); // Get new F + if (ColCorrChk.Checked) then + begin + outline := 'Row Dimensions (Ignore Col. 1)'; + MAT_PRINT(F,n,q1,outline,RowLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + if ((PlotChk.Checked) and (ColCorrChk.Checked)) then + begin + prompt := InputBox('X Axis Dimension','1','1'); + IX := StrToInt(prompt); + prompt := InputBox('Y Axis Dimension','2','2'); + IY := StrToInt(prompt); + SetLength(X,q1); + SetLength(Y,q1); + xtitle := 'Dimension ' + IntToStr(IX); + ytitle := 'Dimension ' + IntToStr(IY); + Xmax := -10000.0; + Ymax := Xmax; + Xmin := 10000.0; + Ymin := Xmin; + for i := 0 to q1 - 1 do + begin + X[i] := Gc[i,IX]; + if (X[i] > Xmax) then Xmax := X[i]; + if (X[i] < Xmin) then Xmin := X[i]; + Y[i] := Gc[i,IY]; + if (Y[i] > Ymax) then Ymax := Y[i]; + if (Y[i] < Ymin) then Ymin := Y[i]; + end; + title := 'Column Dimensions'; + plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,q1,ColLabels, title,xtitle,ytitle); + BlankFrm.ShowModal; + Y := nil; + X := nil; + SetLength(X,n); + SetLength(Y,n); + Xmax := -10000.0; + Ymax := Xmax; + Xmin := 10000.0; + Ymin := Xmin; + for i := 0 to n - 1 do + begin + X[i] := F[i,IX]; + if (X[i] > Xmax) then Xmax := X[i]; + if (X[i] < Xmin) then Xmin := X[i]; + Y[i] := F[i,IY]; + if (Y[i] > Ymax) then Ymax := Y[i]; + if (Y[i] < Ymin) then Ymin := Y[i]; + end; + title := 'Row Dimensions'; + plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,n,RowLabels, title,xtitle,ytitle); + BlankFrm.ShowModal; + Y := nil; + X := nil; + end; +// end; + + // do both if checked + if (BothCorrChk.Checked) then + begin + // F is same as for Row correspondence and Gc is same as for columns + for i := 0 to n - 1 do + for j := 0 to q1 - 1 do W[i,j] := F[i,j]; + MATAxB(F,W,Du,n,q1,q1,q1,errorcode); + outline := 'Row Dimensions (Ignore Col. 1'; + MAT_PRINT(F,n,q1,outline,RowLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + outline := 'Column Dimensions (Ignore Col. 1)'; + MAT_PRINT(Gc,q1,q1,outline,ColLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + if (PlotChk.Checked)then + begin + prompt := InputBox('X Axis Dimension','1','1'); + IX := StrToInt(prompt); + prompt := InputBox('Y Axis Dimension','2','2'); + IY := StrToInt(prompt); + xtitle := 'Dimension ' + IntToStr(IX); + ytitle := 'Dimension ' + IntToStr(IY); + SetLength(X,n); + SetLength(Y,n); + Xmax := -10000.0; + Ymax := Xmax; + Xmin := 10000.0; + Ymin := Xmin; + for i := 0 to n - 1 do + begin + X[i] := F[i,IX]; + if (X[i] > Xmax) then Xmax := X[i]; + if (X[i] < Xmin) then Xmin := X[i]; + Y[i] := F[i,IY]; + if (Y[i] > Ymax) then Ymax := Y[i]; + if (Y[i] < Ymin) then Ymin := Y[i]; + end; + title := 'Row Dimensions'; + plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,n,RowLabels, title,xtitle,ytitle); + BlankFrm.ShowModal; + Y := nil; + X := nil; + SetLength(X,q1); + SetLength(Y,q1); + Xmax := -10000.0; + Ymax := Xmax; + Xmin := 10000.0; + Ymin := Xmin; + for i := 0 to q1 - 1 do + begin + X[i] := Gc[i,IX]; + if (X[i] > Xmax) then Xmax := X[i]; + if (X[i] < Xmin) then Xmin := X[i]; + Y[i] := Gc[i,IY]; + if (Y[i] > Ymax) then Ymax := Y[i]; + if (Y[i] < Ymin) then Ymin := Y[i]; + end; + title := 'Column Dimensions'; + plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,q1,ColLabels, title,xtitle,ytitle); + BlankFrm.ShowModal; + Y := nil; + X := nil; + end; + end; +// FrmOutPut.ShowModal; + +// clean up memory + Gc := nil; + F := nil; + Trans := nil; + W := nil; + V := nil; + q := nil; + B := nil; + Du := nil; + A := nil; + Dc := nil; + Dr := nil; + c := nil; + r := nil; + P := nil; + ColLabels := nil; + RowLabels := nil; + CellChi := nil; + Expected := nil; + Prop := nil; + Freq := nil; + ColNoSelected := nil; +end; +end; + +procedure TCorrespondenceForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TCorrespondenceForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if BlankFrm = nil then + Application.CreateForm(TBlankFrm, BlankFrm); +end; + +procedure TCorrespondenceForm.HelpBtnClick(Sender: TObject); +begin + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TCorrespondenceForm.plotxy(Xpoints, Ypoints : DblDyneVec; Xmax, Xmin, Ymax, + Ymin : double; N : integer; + PtLabels : StrDyneVec; titlestr, + Xlabel, Ylabel : string); +VAR + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide :integer; + vhi, hwide, offset, strhi, imagehi : integer; + valincr, Yvalue, Xvalue, value : double; + Title, astring, outline : string; + +begin + Title := 'X versus Y PLOT'; + BlankFrm.Caption := Title; + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + BlankFrm.Image1.Canvas.FloodFill(0,0,clYellow,fsBorder); + vtop := 20; + vbottom := round(imagehi) - 80; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + + // Draw chart border + BlankFrm.Image1.Canvas.Rectangle(0,0,imagewide,imagehi); + + // draw horizontal axis + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom); + valincr := (Xmax - Xmin) / 10.0; + for i := 1 to 11 do + begin + ypos := vbottom; + Xvalue := Xmin + valincr * (i - 1); + xpos := round(hwide * ((Xvalue - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + outline := format('%6.2f',[Xvalue]); + Title := outline; + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + xpos := xpos - offset; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + astring := Xlabel; // 'Dimension 1'; + xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(astring) div 2); + ypos := vbottom + 20; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,astring); + + // Draw vertical axis + Title := Ylabel; // 'Dimension 2'; + xpos := hleft - BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + ypos := vtop - BlankFrm.Image1.Canvas.TextHeight(Title); + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + xpos := hleft; + ypos := vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := vbottom; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + valincr := (Ymax - Ymin) / 10.0; + for i := 1 to 11 do + begin + value := Ymax - ((i-1) * valincr); + outline := format('%8.3f',[value]); + Title := outline; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := 10; + Yvalue := Ymax - (valincr * (i-1)); + ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + xpos := hleft; + ypos := ypos + strhi div 2; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hleft - 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // draw points for x and y pairs + BlankFrm.Image1.Canvas.Font.Size := 8; + for i := 0 to N - 1 do + begin + ypos := round(vhi * ( (Ymax - Ypoints[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.Brush.Color := clNavy; + BlankFrm.Image1.Canvas.Brush.Style := bsSolid; + BlankFrm.Image1.Canvas.Pen.Color := clNavy; + BlankFrm.Image1.Canvas.Ellipse(xpos,ypos,xpos+5,ypos+5); + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.TextOut(xpos+3,ypos-5,PtLabels[i]); + end; + xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(titlestr) div 2); + ypos := vbottom + 40; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,titlestr); +end; + +procedure TCorrespondenceForm.RowInClick(Sender: TObject); +VAR + index : integer; +begin + index := VarList.ItemIndex; + RowEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + RowIn.Enabled := false; + RowOut.Enabled := true; +end; + +procedure TCorrespondenceForm.RowOutClick(Sender: TObject); +begin + VarList.Items.Add(RowEdit.Text); + RowEdit.Text := ''; + RowIn.Enabled := true; + RowOut.Enabled := false; +end; + +initialization + {$I correspondenceunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multivariate/discrimunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/discrimunit.lfm new file mode 100644 index 000000000..28b6d68f8 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/discrimunit.lfm @@ -0,0 +1,565 @@ +object DiscrimFrm: TDiscrimFrm + Left = 558 + Height = 457 + Top = 229 + Width = 605 + AutoSize = True + Caption = 'Discriminant Function and Multivariate Analysis of Variance' + ClientHeight = 457 + ClientWidth = 605 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 304 + Height = 25 + Top = 424 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 2 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 370 + Height = 25 + Top = 424 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 444 + Height = 25 + Top = 424 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 532 + Height = 25 + Top = 424 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 5 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Panel2 + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 400 + Top = 8 + Width = 396 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 400 + ClientWidth = 396 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 92 + Caption = 'Available Variable' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + Left = 220 + Height = 15 + Top = 0 + Width = 77 + BorderSpacing.Left = 8 + Caption = 'Group Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = PredList + AnchorSideBottom.Control = PredList + Left = 220 + Height = 15 + Top = 92 + Width = 97 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Predictor Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepIn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 383 + Top = 17 + Width = 176 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object DepIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 184 + Height = 28 + Top = 17 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = DepInClick + Spacing = 0 + TabOrder = 1 + end + object DepOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepIn + AnchorSideTop.Side = asrBottom + Left = 184 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = DepOutClick + Spacing = 0 + TabOrder = 2 + end + object PredIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepOut + AnchorSideTop.Side = asrBottom + Left = 184 + Height = 28 + Top = 109 + Width = 28 + BorderSpacing.Top = 32 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = PredInClick + Spacing = 0 + TabOrder = 4 + end + object PredOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = PredIn + AnchorSideTop.Side = asrBottom + Left = 184 + Height = 28 + Top = 141 + Width = 28 + BorderSpacing.Top = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = PredOutClick + Spacing = 0 + TabOrder = 5 + end + object GroupVar: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideTop.Control = DepIn + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 220 + Height = 23 + Top = 17 + Width = 176 + Anchors = [akTop, akLeft, akRight] + TabOrder = 3 + Text = 'GroupVar' + end + object PredList: TListBox + AnchorSideLeft.Control = PredIn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = PredIn + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 220 + Height = 291 + Top = 109 + Width = 176 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + ItemHeight = 0 + TabOrder = 6 + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 408 + Width = 605 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel2: TPanel + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 412 + Height = 408 + Top = 0 + Width = 193 + Anchors = [akTop, akRight, akBottom] + AutoSize = True + BevelOuter = bvNone + ClientHeight = 408 + ClientWidth = 193 + TabOrder = 1 + object OptionsGroup: TGroupBox + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 282 + Top = 8 + Width = 185 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 262 + ClientWidth = 181 + TabOrder = 0 + object DescChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 157 + Caption = 'Descriptive Statistics' + TabOrder = 0 + end + object CorrsChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 157 + Caption = 'Correlations' + TabOrder = 1 + end + object InvChk: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 157 + Caption = 'Matrix Inverses' + TabOrder = 2 + end + object PlotChk: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 157 + Caption = 'Plot Scores' + TabOrder = 3 + end + object ClassChk: TCheckBox + Left = 12 + Height = 19 + Top = 90 + Width = 157 + Caption = 'Classify Scores' + TabOrder = 4 + end + object AnovaChk: TCheckBox + Left = 12 + Height = 19 + Top = 111 + Width = 157 + Caption = 'One-Way ANOVAs' + TabOrder = 5 + end + object CrossChk: TCheckBox + Left = 12 + Height = 19 + Top = 132 + Width = 157 + Caption = 'Cross-Products' + TabOrder = 6 + end + object DevCPChk: TCheckBox + Left = 12 + Height = 19 + Top = 153 + Width = 157 + Caption = 'Deviation Cross-Products' + TabOrder = 7 + end + object EigensChk: TCheckBox + Left = 12 + Height = 19 + Top = 174 + Width = 157 + Caption = 'Eigen Vectors' + TabOrder = 8 + end + object PCovChk: TCheckBox + Left = 12 + Height = 19 + Top = 195 + Width = 157 + Caption = 'Pooled Within Covariance' + TabOrder = 9 + end + object CentroidsChk: TCheckBox + Left = 12 + Height = 19 + Top = 216 + Width = 157 + Caption = 'Centroids' + TabOrder = 10 + end + object ScoresChk: TCheckBox + Left = 12 + Height = 19 + Top = 237 + Width = 157 + Caption = 'Scores to the Grid' + TabOrder = 11 + end + end + object ClassSizeGroup: TRadioGroup + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = OptionsGroup + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 93 + Top = 306 + Width = 185 + Anchors = [akTop, akLeft, akRight] + AutoFill = False + AutoSize = True + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + Caption = 'Classify Using:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 73 + ClientWidth = 181 + Items.Strings = ( + 'Equal Group Sizes' + 'Existing Sample Sizes' + 'Entered Prior Sizes' + ) + TabOrder = 1 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/multivariate/discrimunit.pas b/applications/lazstats/source/forms/analysis/multivariate/discrimunit.pas new file mode 100644 index 000000000..ac0d8a7ac --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/discrimunit.pas @@ -0,0 +1,1247 @@ +unit DiscrimUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, GraphLib, Globals, DataProcs, + MatrixLib, DictionaryUnit; + +type + + { TDiscrimFrm } + + TDiscrimFrm = class(TForm) + Bevel1: TBevel; + Panel1: TPanel; + Panel2: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + DescChk: TCheckBox; + PCovChk: TCheckBox; + CentroidsChk: TCheckBox; + ScoresChk: TCheckBox; + CorrsChk: TCheckBox; + InvChk: TCheckBox; + PlotChk: TCheckBox; + ClassChk: TCheckBox; + AnovaChk: TCheckBox; + CrossChk: TCheckBox; + DevCPChk: TCheckBox; + EigensChk: TCheckBox; + DepIn: TBitBtn; + DepOut: TBitBtn; + OptionsGroup: TGroupBox; + PredIn: TBitBtn; + PredOut: TBitBtn; + GroupVar: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + PredList: TListBox; + ClassSizeGroup: TRadioGroup; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure DepInClick(Sender: TObject); + procedure DepOutClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure PredInClick(Sender: TObject); + procedure PredOutClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + MaxGrp : integer; + MinGrp : integer; + procedure PlotPts(Sender: TObject; RawCMat : DblDyneMat; + Constants : DblDyneVec; + ColNoSelected : IntDyneVec; + NoSelected : integer; + noroots : integer; + NoCases : integer; + GrpVar : integer; + NoGrps : integer; + NoInGrp : IntDyneVec); + + procedure Classify(Sender: TObject; PooledW : DblDyneMat; + GrpMeans : DblDyneMat; + ColNoSelected : IntDyneVec; + NoSelected : integer; + NoCases : integer; + GrpVar : integer; + NoGrps : integer; + NoInGrp : IntDyneVec; + VarLabels : StrDyneVec); + + procedure ClassIt(Sender: TObject; PooledW : DblDyneMat; + ColNoSelected : IntDyneVec; + GrpMeans : DblDyneMat; + Roots : DblDyneVec; + noroots : integer; + GrpVar : integer; + NoGrps : integer; + NoInGrp : IntDyneVec; + NoSelected : integer; + NoCases : integer; + RawCmat : DblDyneMat; + Constants : DblDyneVec); + public + { public declarations } + end; + +var + DiscrimFrm: TDiscrimFrm; + +implementation + +uses + Math; + +{ TDiscrimFrm } + +procedure TDiscrimFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + PredList.Clear; + PredOut.Enabled := false; + PredIn.Enabled := true; + DepOut.Enabled := false; + DepIn.Enabled := true; + GroupVar.Text := ''; + DescChk.Checked := false; + CorrsChk.Checked := false; + InvChk.Checked := false; + PlotChk.Checked := false; + ClassChk.Checked := false; + AnovaChk.Checked := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TDiscrimFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + Panel1.Constraints.MinWidth := OptionsGroup.Width * 2 + DepIn.Width; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := True; +end; + +procedure TDiscrimFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TDiscrimFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TDiscrimFrm.DepInClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + GroupVar.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + DepOut.Enabled := true; + DepIn.Enabled := false; +end; + +procedure TDiscrimFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, grp, grpvalue, matrow, matcol, noroots, dfchi, n2, k2 : integer; + NoSelected : integer; + outline, GroupLabel, ColHead : string; + Title : string; + GrpVar, NoGrps, nowithin, TotalCases, value, grpno : integer; + ColNoSelected : IntDyneVec; + CaseNo, NoInGrp : IntDyneVec; + VarLabels, ColLabels, GrpNos : StrDyneVec; + X, Y, GroupSS, ErrorSS, GroupMS, ErrorMS, TotalSS, num, s, v2, den : double; + Lambda, ChiSquare, Pillia, TotChi, p, Rc, chi, chiprob, m, L2, F, Fprob : double; + DFGroup, DFError, DFTotal, Fratio, prob, minroot, trace, pcnttrace : double; + probchi : double; + WithinMat, WithinInv, WinvB, v, PooledW, TotalMat, BetweenMat : DblDyneMat; + EigenVectors, EigenTrans, TempMat, Theta, DiagMat, CoefMat : DblDyneMat; + RawCMat, GrpMeans, GrpSDevs, Centroids, Structure : DblDyneMat; + Constants, ScoreVar, Roots, Pcnts, TotalMeans, TotalVariances : DblDyneVec; + TotalStdDevs, WithinMeans, WithinVariances, WithinStdDevs, w : DblDyneVec; + errorcode : boolean = false; +begin + TotalCases := 0; + OutputFrm.RichEdit.Clear(); + OutputFrm.RichEdit.Lines.Add('MULTIVARIATE ANOVA / DISCRIMINANT FUNCTION'); + OutputFrm.RichEdit.Lines.Add('Reference: Multiple Regression in Behavioral Research'); + OutputFrm.RichEdit.Lines.Add('Elazar J. Pedhazur, 1997, Chapters 20-21'); + OutputFrm.RichEdit.Lines.Add('Harcourt Brace College Publishers'); + NoSelected := PredList.Items.Count + 1; + SetLength(ColNoSelected,NoVariables); + SetLength(VarLabels,NoVariables); + SetLength(ColLabels,NoVariables); + SetLength(CaseNo,NoVariables); + + // Get items selected + for i := 1 to NoSelected - 1 do + begin + for j := 1 to NoVariables do + begin + if (PredList.Items.Strings[i-1] = OS3MainFrm.DataGrid.Cells[j,0]) then + begin + ColNoSelected[i-1] := j; + VarLabels[i-1] := OS3MainFrm.DataGrid.Cells[j,0]; + end; + if GroupVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then + begin + GrpVar := j; + GroupLabel := OS3MainFrm.DataGrid.Cells[j,0]; + ColNoSelected[NoSelected-1] := j; + end; + end; // next j variable + end; // next i predictor + + //Allocate memory for analyses + SetLength(WithinMat,NoVariables,NoVariables); + SetLength(WithinInv,NoVariables,NoVariables); + SetLength(WinvB,NoVariables,NoVariables); + SetLength(v,NoVariables,NoVariables); + SetLength(PooledW,NoVariables,NoVariables); + SetLength(TotalMat,NoVariables,NoVariables); + SetLength(BetweenMat,NoVariables,NoVariables); + SetLength(EigenVectors,NoVariables,NoVariables); + SetLength(EigenTrans,NoVariables,NoVariables); + SetLength(TempMat,NoVariables,NoVariables); + SetLength(Theta,NoVariables,NoVariables); + SetLength(DiagMat,NoVariables,NoVariables); + SetLength(CoefMat,NoVariables,NoVariables); + SetLength(RawCMat,NoVariables,NoVariables); + SetLength(Structure,NoVariables,NoVariables); + SetLength(Constants,NoVariables); + SetLength(ScoreVar,NoVariables); + SetLength(Roots,NoVariables); + SetLength(Pcnts,NoVariables); + SetLength(TotalMeans,NoVariables); + SetLength(TotalVariances,NoVariables); + SetLength(TotalStdDevs,NoVariables); + SetLength(WithinMeans,NoVariables); + SetLength(WithinVariances,NoVariables); + SetLength(WithinStdDevs,NoVariables); + SetLength(w,NoVariables); + + // Initialize arrays + for i := 0 to NoSelected-1 do + begin + TotalMeans[i] := 0.0; + TotalVariances[i] := 0.0; + WithinMeans[i] := 0.0; + WithinVariances[i] := 0.0; + for j := 0 to NoSelected-1 do + begin + TotalMat[i,j] := 0.0; + WithinMat[i,j] := 0.0; + PooledW[i,j] := 0.0; + end; + end; + + //Get minimum and maximum group numbers (and no. of groups) + MinGrp := 1000; + MaxGrp := 0; + for i := 1 to NoCases do + begin + if (GoodRecord(i,NoSelected,ColNoSelected)) then + begin + value := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); + if (value < MinGrp) then MinGrp := value; + if (value > MaxGrp) then MaxGrp := value; + end; + end; // next case + NoGrps := MaxGrp - MinGrp + 1; + + //Allocate space for group means, standard deviations and centroids + SetLength(GrpMeans,NoGrps,NoSelected); + SetLength(GrpSDevs,NoGrps,NoSelected); + SetLength(Centroids,NoGrps,NoSelected); + SetLength(GrpNos,NoGrps); + SetLength(NoInGrp,NoGrps); + + //Initialize group variables + for i := 0 to NoGrps-1 do + begin + for j := 0 to NoSelected-1 do + begin + Centroids[i,j] := 0.0; + GrpMeans[i,j] := 0.0; + GrpSDevs[i,j] := 0.0; + end; + end; + + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Total Cases := %d, Number of Groups := %d', + [NoCases, NoGrps]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + //Read the data for each group, accumulating cross-products and sums + for grp := 1 to NoGrps do + begin + nowithin := 0; + grpvalue := grp; + for i := 1 to NoCases do + begin + if (GoodRecord(i,NoSelected,ColNoSelected)) then + begin + grpno := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); + grpno := NoGrps - (MaxGrp - grpno); + if (grpno = grpvalue) then // case belongs to this group + begin + GrpNos[grp-1] := IntToStr(grpno); + nowithin := nowithin + 1; + TotalCases := TotalCases + 1; + for j := 1 to NoSelected - 1 do // matrix row + begin + matrow := ColNoSelected[j-1]; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[matrow,i])); + for k := 1 to NoSelected - 1 do // matrix col. + begin + matcol := ColNoSelected[k-1]; + Y := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[matcol,i])); + WithinMat[j-1,k-1] := WithinMat[j-1,k-1] + (X * Y); + TotalMat[j-1,k-1] := TotalMat[j-1,k-1] + (X * Y); + end; + WithinMeans[j-1] := WithinMeans[j-1] + X; + WithinVariances[j-1] := WithinVariances[j-1] + (X * X); + TotalMeans[j-1] := TotalMeans[j-1] + X; + TotalVariances[j-1] := TotalVariances[j-1] + (X * X); + end; // next variable j + end; // if group number match + end; // end if valid record + end; // next case + + // Does user want cross-products matrices ? + if (CrossChk.Checked = true) then + begin + // print within matrix + ColHead := format('Group %d, N = %d',[grp,nowithin]); + Title := 'SUM OF CROSS-PRODUCTS for ' + ColHead; + MAT_PRINT(WithinMat,NoSelected-1,NoSelected-1,Title,VarLabels,VarLabels,nowithin); + end; + + // Convert to deviation cross-products and pool + for j := 1 to NoSelected - 1 do + begin + for k := 1 to NoSelected - 1 do + begin + WithinMat[j-1,k-1] := WithinMat[j-1,k-1] - + (WithinMeans[j-1] * WithinMeans[k-1] / nowithin); + PooledW[j-1,k-1] := PooledW[j-1,k-1] + WithinMat[j-1,k-1]; + end; + end; + + // Does user want deviation cross-products? + if (DevCPChk.Checked = true) then + begin + // print within matrix + ColHead := format('Group %d, N := %d',[grpvalue,nowithin]); + Title := 'WITHIN GROUP SUM OF DEVIATION CROSS-PRODUCTS ' + ColHead; + MAT_PRINT(WithinMat,NoSelected-1,NoSelected-1,Title,VarLabels, + VarLabels,nowithin); + end; + + // Compute descriptives from sums and sums of squares + for j := 1 to NoSelected - 1 do + begin + WithinVariances[j-1] := WithinVariances[j-1] - + (WithinMeans[j-1] * WithinMeans[j-1] / nowithin); + WithinVariances[j-1] := WithinVariances[j-1] / (nowithin-1); + WithinStdDevs[j-1] := sqrt(WithinVariances[j-1]); + WithinMeans[j-1] := WithinMeans[j-1] / nowithin; + end; + + // Does user want descriptives ? + if DescChk.Checked then + begin + // print mean, variance and std. dev.s for variables + outline := format('MEANS FOR GROUP %d, N := %d',[grp,nowithin]); + DynVectorPrint(WithinMeans,NoSelected-1,outline,VarLabels,nowithin); + outline := format('VARIANCES FOR GROUP %d',[grp]); + DynVectorPrint(WithinVariances,NoSelected-1,outline,VarLabels,nowithin); + outline := format('STANDARD DEVIATIONS FOR GROUP %d',[grp]); + DynVectorPrint(WithinStdDevs,NoSelected-1,outline,VarLabels,nowithin); + end; + if (DescChk.Checked) or (DevCPChk.Checked) or (CrossChk.Checked) then + begin + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + end; + + // Now initialize for the next group and save descriptives + for j := 1 to NoSelected - 1 do + begin + GrpMeans[grp-1,j-1] := WithinMeans[j-1]; + WithinMeans[j-1] := 0.0; + GrpSDevs[grp-1,j-1] := WithinStdDevs[j-1]; + WithinVariances[j-1] := 0.0; + for k := 1 to NoSelected - 1 do WithinMat[j-1,k-1] := 0.0; + end; + NoInGrp[grp-1] := nowithin; + end; // next group + + // Does user want cross-products matrices ? + if CrossChk.Checked then + begin + // print Total cross-products matrix + Title := 'TOTAL SUM OF CROSS-PRODUCTS'; + MAT_PRINT(TotalMat,NoSelected-1,NoSelected-1,Title,VarLabels,VarLabels,TotalCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + end; + + //Obtain Total deviation cross-products + for j := 1 to NoSelected - 1 do + for k := 1 to NoSelected - 1 do + TotalMat[j-1,k-1] := TotalMat[j-1,k-1] - + (TotalMeans[j-1] * TotalMeans[k-1] / TotalCases); + + // Does user want deviation cross-products? + if DevCPChk.Checked then + begin + // print total deviation cross-products matrix + Title := 'TOTAL SUM OF DEVIATION CROSS-PRODUCTS'; + MAT_PRINT(TotalMat,NoSelected-1,NoSelected-1,Title,VarLabels,VarLabels,TotalCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + end; + for j := 1 to NoSelected - 1 do + begin + TotalVariances[j-1] := TotalVariances[j-1] - + (TotalMeans[j-1] * TotalMeans[j-1] / TotalCases); + TotalVariances[j-1] := TotalVariances[j-1] / (TotalCases - 1); + TotalStdDevs[j-1] := sqrt(TotalVariances[j-1]); + TotalMeans[j-1] := TotalMeans[j-1] / TotalCases; + end; + + // Does user want descriptives ? + if DescChk.Checked then + begin + // print mean, variance and std. dev.s for variables + Title := 'MEANS'; + DynVectorPrint(TotalMeans,NoSelected-1,Title,VarLabels,TotalCases); + Title := 'VARIANCES'; + DynVectorPrint(TotalVariances,NoSelected-1,Title,VarLabels,TotalCases); + Title := 'STANDARD DEVIATIONS'; + DynVectorPrint(TotalStdDevs,NoSelected-1,Title,VarLabels,TotalCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + end; + + // Obtain between groups deviation cross-products matrix + MATSUB(BetweenMat,TotalMat,PooledW,NoSelected-1,NoSelected-1, + NoSelected-1,NoSelected-1,errorcode); + + // Does user want deviation cross-products? + if DevCPChk.Checked then + begin + // print between groups deviation cross-products matrix + Title := 'BETWEEN GROUPS SUM OF DEV. CPs'; + MAT_PRINT(BetweenMat,NoSelected-1,NoSelected-1,Title,VarLabels, + VarLabels,TotalCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + end; + + // Do univariate ANOVA's for each variable + if AnovaChk.Checked then + begin + for j := 1 to NoSelected - 1 do + begin + outline := format('UNIVARIATE ANOVA FOR VARIABLE %s', + [VarLabels[j-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add('SOURCE DF SS MS F PROB > F'); + GroupSS := BetweenMat[j-1,j-1]; + ErrorSS := PooledW[j-1,j-1]; + TotalSS := TotalMat[j-1,j-1]; + DFGroup := NoGrps - 1; + DFError := TotalCases - NoGrps; + DFTotal := TotalCases - 1; + GroupMS := GroupSS / DFGroup; + ErrorMS := ErrorSS / DFError; + Fratio := GroupMS / ErrorMS; + prob := probf(Fratio,DFGroup,DFError); + outline := format('BETWEEN %3.0f%10.3f%10.3f%10.3f%10.3f', + [DFGroup,GroupSS,GroupMS,Fratio,prob]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('ERROR %3.0f%10.3f%10.3f', + [DFError,ErrorSS,ErrorMS]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('TOTAL %3.0f%10.3f',[DFTotal,TotalSS]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + end; + + // Get roots of the product of the within group inverse times between + // Inverse routine starts at 1, not 0. Setup temps for inverse + for i := 1 to NoSelected - 1 do + for j := 1 to NoSelected - 1 do + WithinInv[i-1,j-1] := PooledW[i-1,j-1]; + SVDinverse(WithinInv,NoSelected-1); + + // Does user want inverse of pooled within deviation cross-products? + if InvChk.Checked then + begin + Title := 'Inv. of Pooled Within Dev. CPs Matrix'; + MAT_PRINT(WithinInv,NoSelected-1,NoSelected-1,Title,VarLabels,VarLabels,TotalCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + end; + + // Get roots of the W inverse times Betweeen matrices + MATAxB(WinvB,WithinInv,BetweenMat,NoSelected-1,NoSelected-1,NoSelected-1,NoSelected-1,errorcode); + minroot := 0.0; + noroots := 0; + if (NoGrps <= NoSelected-1) then noroots := NoGrps-1 else noroots := NoSelected-1; + trace := 0.0; + pcnttrace := 0.0; + nonsymroots(WinvB,NoSelected-1,noroots,minroot,EigenVectors,Roots,Pcnts,trace,pcnttrace); + outline := format('Number of roots extracted := %d',[noroots]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Percent of trace extracted := %10.4f',[pcnttrace]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := 'Roots of the W inverse time B Matrix'; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := 'No. Root Proportion Canonical R Chi-Squared D.F. Prob.'; + OutputFrm.RichEdit.Lines.Add(outline); + Lambda := 1.0; + ChiSquare := 0.0; + Pillia := 0.0; + for i := 1 to noroots do + begin + Lambda := Lambda * (1.0 / (1.0 + Roots[i-1])); + ChiSquare := ChiSquare + ln(1.0 + Roots[i-1]); + Pillia := Pillia + (Roots[i-1] / (1.0 + Roots[i-1])); + end; + TotChi := ChiSquare; + for i := 1 to noroots do + begin + p := Roots[i-1] / trace; + Rc := sqrt(Roots[i-1] / (1.0 + Roots[i-1])); + dfchi := (NoSelected - i) * (NoGrps - i ); + chi := TotChi * (TotalCases - 1.0 - 0.5 * (NoSelected + NoGrps)); + chiprob := 1.0 - chisquaredprob(chi,dfchi); + outline := format('%2d %10.4f %6.4f %6.4f %10.4f %3d %6.3f', + [i,Roots[i-1],p,Rc,chi,dfchi,chiprob]); + OutputFrm.RichEdit.Lines.Add(outline); + TotChi := TotChi - ln(1.0 + Roots[i-1]); + end; + ChiSquare := ChiSquare * ((TotalCases - 1) - (0.5 * (NoSelected - 1 + NoGrps))); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + + for i := 1 to noroots do ColLabels[i-1] := IntToStr(i); + if EigensChk.Checked then + begin + Title := 'Eigenvectors of the W inverse x B Matrix'; + MAT_PRINT(EigenVectors,NoSelected-1,noroots,Title,VarLabels,ColLabels,TotalCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + end; + + // Now get covariance matrices for the total and within + for i := 1 to NoSelected - 1 do + begin + for j := 1 to NoSelected - 1 do + begin + TotalMat[i-1,j-1] := TotalMat[i-1,j-1] / (TotalCases - 1); + PooledW[i-1,j-1] := PooledW[i-1,j-1] / (TotalCases - NoGrps); + end; + end; + + if PCovChk.Checked then + begin + Title := 'Pooled Within-Groups Covariance Matrix'; + MAT_PRINT(PooledW,NoSelected-1,NoSelected-1,Title,VarLabels,VarLabels,TotalCases); + Title := 'Total Covariance Matrix'; + MAT_PRINT(TotalMat,NoSelected-1,NoSelected-1,Title,VarLabels,VarLabels,TotalCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + end; + + //Get the pooled within groups variance-covariance of disc. scores matrix v'C v + MATTRN(EigenTrans,EigenVectors, NoSelected-1,noroots); // v' + MATAxB(TempMat,EigenTrans,PooledW,noroots,NoSelected-1,NoSelected-1, + NoSelected-1,errorcode);//v'C + MATAxB(Theta,TempMat,EigenVectors,noroots,NoSelected-1,NoSelected-1, + noroots, errorcode); //v'C v + + //Create a diagonal matrix with square roots of the diagonal of the Within + for i := 1 to NoSelected - 1 do + begin + for j := 1 to NoSelected - 1 do + begin + if (i <> j) then DiagMat[i-1,j-1] := 0.0 + else DiagMat[i-1,j-1] := sqrt(PooledW[i-1,j-1]); + end; + end; + + // Get recipricol of standard deviations of each function + for i := 1 to noroots do + ScoreVar[i-1] := 1.0 / sqrt(Theta[i-1,i-1]); + + // Divide coefficients by their standard deviations + for i := 1 to NoSelected - 1 do + begin + for j := 1 to noroots do + begin + RawCMat[i-1,j-1] := EigenVectors[i-1,j-1] * ScoreVar[j-1]; // raw coeff. + CoefMat[i-1,j-1] := RawCMat[i-1,j-1] * sqrt(PooledW[i-1,i-1]); + end; + end; + + // Get constants for raw score equations + for i := 1 to noroots do + begin + Constants[i-1] := 0.0; + for j := 1 to NoSelected - 1 do + begin + Constants[i-1] := Constants[i-1] - (RawCMat[j-1,i-1] * TotalMeans[j-1]); + end; + end; + + // Plot discriminant scores? + if PlotChk.Checked then + begin + PlotPts(self,RawCMat,Constants,ColNoSelected,NoSelected, + noroots,NoCases,GrpVar,NoGrps,NoInGrp); + end; + + // print discrim functions + Title := 'Raw Function Coeff.s from Pooled Cov.'; + MAT_PRINT(RawCMat,NoSelected-1,noroots,Title,VarLabels,ColLabels,TotalCases); + Title := 'Raw Discriminant Function Constants'; + DynVectorPrint(Constants,noroots,Title,ColLabels,TotalCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + + //Does user want to classify cases using canonical functions? + if ClassChk.Checked then + begin + Classify(self,PooledW, GrpMeans, ColNoSelected, NoSelected-1, NoCases, + GrpVar, NoGrps, NoInGrp, VarLabels); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + ClassIt(self,PooledW,ColNoSelected,GrpMeans,Roots,noroots, GrpVar, + NoGrps,NoInGrp,NoSelected-1,NoCases,RawCMat,Constants); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + // print standardized discrim function coefficients + Title := 'Standardized Coeff. from Pooled Cov.'; + MAT_PRINT(CoefMat,NoSelected-1,noroots,Title,VarLabels,ColLabels,TotalCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + + // Calculate centroids + for k := 1 to NoGrps do + begin + for i := 1 to noroots do + begin + for j := 1 to NoSelected - 1 do + begin + Centroids[k-1,i-1] := Centroids[k-1,i-1] + (RawCMat[j-1,i-1] * GrpMeans[k-1,j-1]); + end; + Centroids[k-1,i-1] := Centroids[k-1,i-1] + Constants[i-1]; + end; + end; + + if CentroidsChk.Checked then + begin + Title := 'Centroids'; + MAT_PRINT(Centroids,NoGrps,noroots,Title,GrpNos,ColLabels,TotalCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + end; + + // Get variance-covariance matrix of functions (theta) + MATTRN(EigenTrans,EigenVectors,NoSelected-1,noroots); + MATAxB(TempMat,EigenTrans,TotalMat,noroots,NoSelected-1,NoSelected-1, + NoSelected-1,errorcode); + MATAxB(Theta,TempMat,EigenVectors,noroots,NoSelected-1,NoSelected-1, + noroots,errorcode); + + // Create a diagonal matrix with square roots of the Total covariance diagonal + for i := 1 to NoSelected - 1 do + begin + for j := 1 to NoSelected - 1 do + begin + if (i <> j) then DiagMat[i-1,j-1] := 0.0 + else DiagMat[i-1,j-1] := sqrt(TotalMat[i-1,j-1]); + end; + end; + + // Get recipricol of standard deviations of each function + for i := 1 to noroots do ScoreVar[i-1] := 1.0 / sqrt(Theta[i-1,i-1]); + + // Divide coefficients by score standard deviations + for i := 1 to NoSelected - 1 do + begin + for j := 1 to noroots do + begin + RawCMat[i-1,j-1] := EigenVectors[i-1,j-1] * ScoreVar[j-1]; + CoefMat[i-1,j-1] := RawCMat[i-1,j-1] * sqrt(TotalMat[i-1,i-1]); + end; + end; + + // print functions obtained from total matrix + Title := 'Raw Coefficients from Total Cov.'; + MAT_PRINT(RawCMat,NoSelected-1,noroots,Title,VarLabels,ColLabels,TotalCases); + Title := 'Raw Discriminant Function Constants'; + DynVectorPrint(Constants,noroots,Title,ColLabels,TotalCases); +// OutputFrm.ShowModal; +// OutputFrm.RichEdit.Clear(); + + // print std. disc coefficients from total matrix + Title := 'Standardized Coeff.s from Total Cov.'; + MAT_PRINT(CoefMat,NoSelected-1,noroots,Title,VarLabels,ColLabels,TotalCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + + // Get correlations from Total covariance matrix + for i := 1 to NoSelected - 1 do + for j := 1 to NoSelected - 1 do + TempMat[i-1,j-1] := TotalMat[i-1,j-1] / + (TotalStdDevs[i-1] * TotalStdDevs[j-1]); + + if CorrsChk.Checked then + begin + Title := 'Total Correlation Matrix'; + MAT_PRINT(TempMat,NoSelected-1,NoSelected-1,Title,VarLabels,VarLabels,TotalCases); +// OutputFrm.ShowModal; +// OutputFrm.RichEdit.Clear(); + end; + + // Obtain structure coefficients + MATAxB(Structure,TempMat,CoefMat,NoSelected-1,NoSelected-1,NoSelected-1,noroots,errorcode); + Title := 'Corr.s Between Variables and Functions'; + MAT_PRINT(Structure,NoSelected-1,noroots,Title,VarLabels,ColLabels,TotalCases); + + //Compute and print overall statistics for equal group centroids + n2 := (NoSelected-1) * (NoSelected-1); + k2 := (NoGrps-1) * (NoGrps-1); + num := (NoSelected-1) * (NoGrps - 1); + s := sqrt((n2 * k2 - 4) / (n2 + k2 - 5)); + v2 := (num - 2.0) / 2.0; + m := ((2 * TotalCases) - (NoSelected - 1) - NoGrps - 2) / 2.0; + den := m * s - v2; + L2 := Power(Lambda,1.0 / s); + F := ((1.0 - L2)/ L2) * (den / num); + Fprob := probf(F,num,den); + outline := format('Wilk''s Lambda = %10.4f.',[Lambda]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('F = %10.4f with D.F. %5.0f and %5.0f . Prob > F = %6.4f', + [F,num,den,Fprob]); + OutputFrm.RichEdit.Lines.Add(outline); + dfchi := (NoSelected - 1) * noroots; + probchi := 1.0 - chisquaredprob(ChiSquare,dfchi); + outline := format('Bartlett Chi-Squared = %10.4f with %d D.F. and prob. = %6.4f', + [ChiSquare,dfchi,probchi]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Pillai Trace = %10.4f',[Pillia]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear(); + + // Clean up heap + ColNoSelected := nil; + NoInGrp := nil; + GrpNos := nil; + Centroids := nil; + GrpSDevs := nil; + GrpMeans := nil; + w := nil; + WithinStdDevs := nil; + WithinVariances := nil; + WithinMeans := nil; + TotalStdDevs := nil; + TotalVariances := nil; + TotalMeans := nil; + Pcnts := nil; + Roots := nil; + ScoreVar := nil; + Constants := nil; + Structure := nil; + RawCMat := nil; + CoefMat := nil; + DiagMat := nil; + Theta := nil; + TempMat := nil; + EigenTrans := nil; + EigenVectors := nil; + BetweenMat := nil; + TotalMat := nil; + PooledW := nil; + v := nil; + WinvB := nil; + WithinInv := nil; + WithinMat := nil; + CaseNo := nil; + ColLabels := nil; + VarLabels := nil; +end; + +procedure TDiscrimFrm.DepOutClick(Sender: TObject); +begin + VarList.Items.Add(GroupVar.Text); + GroupVar.Text := ''; + DepOut.Enabled := false; + DepIn.Enabled := true; +end; + +procedure TDiscrimFrm.PredInClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + PredList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + PredOut.Enabled := true; +end; + +procedure TDiscrimFrm.PredOutClick(Sender: TObject); +VAR index : integer; +begin + index := PredList.ItemIndex; + if index < 0 then + begin + PredOut.Enabled := false; + exit; + end; + VarList.Items.Add(PredList.Items.Strings[index]); + PredList.Items.Delete(index); +end; + +procedure TDiscrimFrm.PlotPts(Sender: TObject; RawCMat: DblDyneMat; + Constants: DblDyneVec; ColNoSelected: IntDyneVec; NoSelected: integer; + noroots: integer; NoCases: integer; GrpVar: integer; NoGrps: integer; + NoInGrp: IntDyneVec); +var + i, j, k, m, grp, matrow, group : integer; + X, Y, XScore, YScore, temp : double; + xpts : DblDyneVec; + ypts : DblDyneVec; + +begin + SetLength(xpts,NoCases); + SetLength(ypts,NoCases); + SetLength(GraphFrm.Ypoints,1,NoCases); + SetLength(GraphFrm.Xpoints,1,NoCases); + if (noroots > 1) then + begin + for i := 1 to noroots - 1 do + begin + for j := i + 1 to noroots do + begin + for k := 1 to NoCases do + begin + XScore := 0.0; + YScore := 0.0; + for grp := 1 to NoGrps do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,k]))); + group := NoGrps - (MaxGrp - group); + if group = grp then + begin + XScore := Constants[i-1]; + YScore := Constants[j-1]; + for m := 1 to NoSelected do + begin + matrow := ColNoSelected[m-1]; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[matrow,k])); + X := X * RawCMat[m-1,i-1]; + XScore := XScore + X; + end; + for m := 1 to NoSelected do + begin + matrow := ColNoSelected[m-1]; + Y := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[matrow,k])); + Y := Y * RawCMat[m-1,j-1]; + YScore := YScore + Y; + end; + GraphFrm.PointLabels[k] := IntToStr(grp); + end; // if group = grp + end; // next group + xpts[k-1] := XScore; + ypts[k-1] := YScore; + end; // next case k + // sort into ascending X order + for k := 1 to NoCases - 1 do + begin + for m := k + 1 to NoCases do + begin + if xpts[k-1] > xpts[m-1] then + begin + temp := xpts[k-1]; + xpts[k-1] := xpts[m-1]; + xpts[m-1] := temp; + temp := ypts[k-1]; + ypts[k-1] := ypts[m-1]; + ypts[m-1] := temp; + end; + end; + end; + for k := 1 to NoCases do + begin + GraphFrm.Ypoints[0,k-1] := ypts[k-1]; + GraphFrm.Xpoints[0,k-1] := xpts[k-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NoCases; + GraphFrm.Heading := 'CASES IN THE DISCRIMINANT SPACE'; + GraphFrm.XTitle := 'Function ' + IntToStr(i); + GraphFrm.YTitle := 'Function ' + IntToStr(j); +// GraphFrm.Ypoints[1] := ypts; +// GraphFrm.Xpoints[1] := xpts; + GraphFrm.AutoScaled := true; + GraphFrm.PtLabels := true; + GraphFrm.GraphType := 7; // 2d points + GraphFrm.BackColor := clYellow; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; // next i + end; // next j + end; // if noroots > 1 + ypts := nil; + xpts := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +procedure TDiscrimFrm.Classify(Sender: TObject; PooledW: DblDyneMat; + GrpMeans: DblDyneMat; ColNoSelected: IntDyneVec; NoSelected: integer; + NoCases: integer; GrpVar: integer; NoGrps: integer; NoInGrp: IntDyneVec; + VarLabels: StrDyneVec); +var + i, j, k, grp : integer; + outline : string; + Constant, T : DblDyneVec; + S : double; + Coeff, WithinInv : DblDyneMat; + +begin +// SetLength(NoInGrp,NoGrps); + SetLength(T,NoSelected); + SetLength(Coeff,NoGrps,NoSelected); + SetLength(WithinInv,NoSelected,NoSelected); + SetLength(Constant,NoGrps); + + // Get inverse of pooled within variance-covariance matrix + for i := 0 to NoSelected-1 do + for j := 0 to NoSelected-1 do + WithinInv[i,j] := PooledW[i,j]; + SVDinverse(WithinInv,NoSelected); + + // Get Fisher Discrim Functions and probabilities + OutputFrm.RichEdit.Lines.Add('Fisher Discriminant Functions'); + for grp := 0 to NoGrps-1 do + begin + Constant[grp] := 0.0; + S := 0.0; + for j := 0 to NoSelected-1 do + for k := 0 to NoSelected-1 do + S := S + WithinInv[j,k] * GrpMeans[grp,j] * GrpMeans[grp,k]; + Constant[grp] := -S / 2.0; + for j := 0 to NoSelected-1 do + begin + T[j] := 0.0; + for k := 0 to NoSelected-1 do + T[j] := T[j] + WithinInv[j,k] * GrpMeans[grp,k]; + end; + for j := 0 to NoSelected-1 do Coeff[grp,j] := T[j]; + outline := format('Group %3d Constant := %6.3f',[grp+1,Constant[grp]]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add('Variable Coefficient'); + for i := 0 to NoSelected-1 do + begin + outline := format(' %3d %6.3f',[i+1,T[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + end; // next group + + // clean up the heap + Constant := nil; + WithinInv := nil; + Coeff := nil; + T := nil; +// NoInGrp := nil; +end; + +procedure TDiscrimFrm.ClassIt(Sender: TObject; PooledW: DblDyneMat; + ColNoSelected: IntDyneVec; GrpMeans: DblDyneMat; Roots: DblDyneVec; + noroots: integer; GrpVar : integer; NoGrps: integer; NoInGrp: IntDyneVec; + NoSelected: integer; NoCases: integer; RawCmat: DblDyneMat; + Constants: DblDyneVec); +var + i, j, k, grp, j1, InGrp, Largest, SecdLarge, oldcolcnt, linecount : integer; + numberstr, prompt, outline, cellname : string; + Table : IntDyneMat; + ProdVec, Dev, D2, Density, ProbGrp, Apriori, Discrim : DblDyneVec; + SumD2, Determinant, LargestProb, SecdProb, X : double; + RowLabels, ColLabels : StrDyneVec; + WithinInv : DblDyneMat; + col : integer; + +begin + SumD2 := 0.0; + oldcolcnt := NoVariables; + SetLength(Table,NoGrps+1,NoGrps+1); + SetLength(ProdVec,NoSelected); + SetLength(Dev,NoSelected); + SetLength(D2,NoGrps); + SetLength(Density,NoGrps); + SetLength(ProbGrp,NoGrps); + SetLength(Apriori,NoGrps); + SetLength(Discrim,noroots); + SetLength(RowLabels,NoGrps+1); + SetLength(ColLabels,NoGrps+1); + SetLength(WithinInv,NoSelected,NoSelected); + + // Does user want to save scores? If yes, add columns to grid + if ScoresChk.Checked then + begin + //Add grid headings for discrim scores + for j := 1 to noroots do + begin + cellname := 'Disc '; + cellname := cellname + IntToStr(j); + col := oldcolcnt + j; + DictionaryFrm.newvar(col); + DictionaryFrm.DictGrid.Cells[1,col] := cellname; + OS3MainFrm.DataGrid.Cells[col,0] := cellname; +// NoVariables := NoVariables + 1; + end; + end; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + + // Initialize arrays that need it + for i := 1 to NoSelected do ProdVec[i-1] := 0.0; + for i := 1 to NoGrps do D2[i-1] := 0.0; + for i := 1 to NoGrps + 1 do + for j := 1 to NoGrps + 1 do Table[i-1,j-1] := 0; + + // Get inverse of pooled within variance-covariance matrix + for i := 1 to NoSelected do + for j := 1 to NoSelected do + WithinInv[i-1,j-1] := PooledW[i-1,j-1]; + SVDinverse(WithinInv,NoSelected); + + // Calculate determinant (product of roots) + Determinant := 1.0; + for i := 1 to noroots do Determinant := Determinant * Roots[i-1]; + + linecount := 0; + // Print Heading + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add(''); + outline := 'CLASSIFICATION OF CASES'; + OutputFrm.RichEdit.Lines.Add(outline); + outline := 'SUBJECT ACTUAL HIGH PROBABILITY SEC.D HIGH DISCRIM'; + OutputFrm.RichEdit.Lines.Add(outline); + outline := 'ID NO. GROUP IN GROUP P(G/D) GROUP P(G/D) SCORE'; + OutputFrm.RichEdit.Lines.Add(outline); + linecount := linecount + 4; + + //Get selected priors + // Default priors are equal proportions + for j := 1 to NoGrps do Apriori[j-1] := 1.0 / NoGrps; + if ClassSizeGroup.ItemIndex = 1 then + begin + // Get apriori probabilities + for j := 1 to NoGrps do + Apriori[j-1] := NoInGrp[j-1] / NoCases; + end; + if ClassSizeGroup.ItemIndex = 2 then // get apriori sizes + begin + for j := 1 to NoGrps do + begin + prompt := 'Group ' + IntToStr(j); + outline := FloatToStr(Apriori[j-1]); + numberstr := InputBox('GROUP PROPORTION:',prompt,outline); + Apriori[j-1] := StrToFloat(numberstr); + end; + end; + + // Calculate group probabilities for each case + for i := 1 to NoCases do + begin + if (linecount >= 59) then + begin + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + linecount := 0; + end; + if (not GoodRecord(i,NoSelected,ColNoSelected))then continue; + InGrp := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); + InGrp := NoGrps - (MaxGrp - InGrp); + for grp := 1 to NoGrps do // group loop + begin + for j := 1 to NoSelected do ProdVec[j-1] := 0.0; + D2[grp-1] := 0.0; + for j := 1 to NoSelected do // variables loop + begin + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNoSelected[j-1],i])); + Dev[j-1] := X - GrpMeans[grp-1,j-1]; + end; + // Get squared distance as [X - M]' * inv[S] * [X - M] + for j := 1 to NoSelected do // deviation * S inverse + for k := 1 to NoSelected do + ProdVec[j-1] := ProdVec[j-1] + (Dev[k-1] * WithinInv[k-1,j-1]); + for j := 1 to NoSelected do // Product * deviation + D2[grp-1] := D2[grp-1] + Dev[j-1] * ProdVec[j-1]; // distance from group + D2[grp-1] := D2[grp-1] - 2.0 * ln(Apriori[grp-1]); ///generalized distance + SumD2 := SumD2 + exp(-0.5 * D2[grp-1]); + end; // end of group loop + for j := 1 to NoGrps do + ProbGrp[j-1] := exp(-0.5 * D2[j-1]) / SumD2; + + // Get Discrim functions + for j := 1 to noroots do Discrim[j-1] := 0.0; + for j := 1 to NoSelected do // variables loop + begin + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNoSelected[j-1],i])); + for j1 := 1 to noroots do + Discrim[j1-1] := Discrim[j1-1] + (X * RawCmat[j-1,j1-1]); + end; + for j := 1 to noroots do Discrim[j-1] := Discrim[j-1] + Constants[j-1]; + + // Does user want to save Discrim scores in grid? + if ScoresChk.Checked then + begin + for j := 1 to noroots do + begin + numberstr := format('%8.3f',[Discrim[j-1]]); + OS3MainFrm.DataGrid.Cells[oldcolcnt+j,i] := numberstr; + end; + end; + + // Get largest and next largest group probabilities + Largest := 1; + LargestProb := ProbGrp[0]; + for grp := 2 to NoGrps do + begin + if (ProbGrp[grp-1] > LargestProb) then + begin + Largest := grp; + LargestProb := ProbGrp[grp-1]; + end; + end; + + ProbGrp[Largest-1] := 0.0; + SecdLarge := 1; + SecdProb := ProbGrp[0]; + for grp := 2 to NoGrps do + begin + if (ProbGrp[grp-1] > SecdProb) then + begin + SecdLarge := grp; + SecdProb := ProbGrp[grp-1]; + end; + end; + + // Print results for this case i + outline := format('%3d %3d %3d %6.4f %3d %6.4f %7.4f', + [i,InGrp,Largest,LargestProb,SecdLarge,SecdProb, + Discrim[0]]); + OutputFrm.RichEdit.Lines.Add(outline); + linecount := linecount + 1; + for j := 2 to noroots do + begin + outline := format(' %7.4f', + [Discrim[j-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + linecount := linecount + 1; + end; + Table[InGrp-1,Largest-1] := Table[InGrp-1,Largest-1] + 1; + // initialize variables for next case + SumD2 := 0.0; + end; // end of case loop i + + // Get table column and row totals + for i := 1 to NoGrps do // table rows + for j := 1 to NoGrps do Table[i-1,NoGrps] := Table[i-1,NoGrps] + Table[i-1,j-1]; + for j := 1 to NoGrps do // table columns + for i := 1 to NoGrps do Table[NoGrps,j-1] := Table[NoGrps,j-1] + Table[i-1,j-1]; + Table[NoGrps,NoGrps] := NoCases; + + if (linecount > 0) then + begin + OutputFrm.ShowModal(); + OutputFrm.RichEdit.Clear; + end; + // Print table of classifications + for i := 1 to NoGrps + 1 do + begin + RowLabels[i-1] := IntToStr(i); + ColLabels[i-1] := IntToStr(i); + end; + RowLabels[NoGrps] := 'TOTAL'; + ColLabels[NoGrps] := 'TOTAL'; + IntArrayPrint(Table, NoGrps+1,NoGrps+1, 'PREDICTED GROUP', + RowLabels, ColLabels, 'CLASSIFICATION TABLE'); + + // Clean up the heap + WithinInv := nil; + ColLabels := nil; + RowLabels := nil; + Discrim := nil; + Apriori := nil; + ProbGrp := nil; + Density := nil; + D2 := nil; + Dev := nil; + ProdVec := nil; + Table := nil; +end; + +initialization + {$I discrimunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multivariate/factorunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/factorunit.lfm new file mode 100644 index 000000000..4537e0e32 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/factorunit.lfm @@ -0,0 +1,528 @@ +object FactorFrm: TFactorFrm + Left = 546 + Height = 522 + Top = 211 + Width = 627 + AutoSize = True + Caption = 'Factor Analysis' + ClientHeight = 522 + ClientWidth = 627 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 326 + Height = 25 + Top = 489 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 2 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 392 + Height = 25 + Top = 489 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 466 + Height = 25 + Top = 489 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 554 + Height = 25 + Top = 489 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 5 + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 473 + Width = 627 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel2: TPanel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel2 + Left = 0 + Height = 114 + Top = 359 + Width = 627 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BevelOuter = bvNone + ClientHeight = 114 + ClientWidth = 627 + TabOrder = 1 + object Label3: TLabel + AnchorSideTop.Control = MinRootEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = MinRootEdit + Left = 450 + Height = 15 + Top = 23 + Width = 122 + Anchors = [akTop, akRight] + BorderSpacing.Right = 4 + Caption = 'Min. root size to rotate:' + ParentColor = False + end + object Label4: TLabel + AnchorSideTop.Control = MaxItersEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = MaxItersEdit + Left = 458 + Height = 15 + Top = 50 + Width = 110 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Maximum Iterations:' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = MaxFactorsEdit + AnchorSideTop.Side = asrCenter + Left = 447 + Height = 15 + Top = 77 + Width = 121 + BorderSpacing.Left = 24 + BorderSpacing.Right = 8 + Caption = 'Maximum No. Factors:' + ParentColor = False + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 114 + Top = 0 + Width = 415 + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Output Options:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 8 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 4 + ClientHeight = 94 + ClientWidth = 411 + TabOrder = 0 + object DescBtn: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 127 + Caption = 'Descriptive Statistics' + TabOrder = 0 + end + object RMatBtn: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 127 + Caption = 'Correlation Matrix' + TabOrder = 1 + end + object UnrotBtn: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 127 + Caption = 'Unrotated Factors' + TabOrder = 2 + end + object PcntTrBtn: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 127 + Caption = 'Percent Trace' + TabOrder = 3 + end + object ScreeBtn: TCheckBox + Left = 147 + Height = 19 + Top = 6 + Width = 101 + Caption = 'Scree Plot' + TabOrder = 4 + end + object ComUnBtn: TCheckBox + Left = 147 + Height = 19 + Top = 27 + Width = 101 + Caption = 'Communalities' + TabOrder = 5 + end + object PlotBtn: TCheckBox + Left = 147 + Height = 19 + Top = 48 + Width = 101 + Caption = 'Plot Factors' + TabOrder = 6 + end + object ScoresBtn: TCheckBox + Left = 147 + Height = 19 + Top = 69 + Width = 101 + Caption = 'Factor Scores' + TabOrder = 7 + end + object SaveCorsBtn: TCheckBox + Left = 256 + Height = 19 + Top = 6 + Width = 143 + Caption = 'Save Correlation Matrix' + TabOrder = 8 + end + object SaveFactBtn: TCheckBox + Left = 256 + Height = 19 + Top = 27 + Width = 143 + Caption = 'Save Factor Matrix' + TabOrder = 9 + end + object SortBtn: TCheckBox + Left = 256 + Height = 19 + Top = 48 + Width = 143 + Caption = 'Sort Factors' + TabOrder = 10 + end + end + object MinRootEdit: TEdit + AnchorSideLeft.Control = MaxFactorsEdit + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = MaxItersEdit + Left = 576 + Height = 23 + Top = 19 + Width = 40 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 17 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 4 + TabOrder = 1 + Text = 'MinRootEdit' + end + object MaxItersEdit: TEdit + AnchorSideLeft.Control = MaxFactorsEdit + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 576 + Height = 23 + Top = 46 + Width = 40 + Alignment = taRightJustify + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + TabOrder = 2 + Text = 'Edit1' + end + object MaxFactorsEdit: TEdit + AnchorSideLeft.Control = Label5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = MaxItersEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 576 + Height = 23 + Top = 73 + Width = 40 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + TabOrder = 3 + Text = 'Edit1' + end + end + object Panel3: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel2 + Left = 0 + Height = 359 + Top = 0 + Width = 627 + Anchors = [akTop, akLeft, akRight, akBottom] + BevelOuter = bvNone + ClientHeight = 359 + ClientWidth = 627 + TabOrder = 0 + object Panel1: TPanel + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = Panel3 + AnchorSideRight.Control = TypeGroup + AnchorSideBottom.Control = Panel3 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 343 + Top = 8 + Width = 407 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 343 + ClientWidth = 407 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = FactorList + AnchorSideTop.Control = Panel1 + Left = 225 + Height = 15 + Top = 0 + Width = 93 + Caption = 'Selected Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 326 + Top = 17 + Width = 181 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Bevel1 + Left = 189 + Height = 28 + Top = 148 + Width = 28 + Anchors = [akLeft, akBottom] + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object FactorList: TListBox + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 225 + Height = 326 + Top = 17 + Width = 182 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + TabOrder = 3 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + Left = 189 + Height = 28 + Top = 184 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object Bevel1: TBevel + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 8 + Top = 176 + Width = 25 + Shape = bsSpacer + end + end + object TypeGroup: TRadioGroup + AnchorSideTop.Control = Panel3 + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + Left = 423 + Height = 177 + Top = 8 + Width = 196 + Anchors = [akTop, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Type of Analysis' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 157 + ClientWidth = 192 + Items.Strings = ( + 'Principal Components' + 'Partial Image (No Iterations)' + 'Guttman Image' + 'Harris Scaled Image' + 'Canonical (Max. Likelihood)' + 'Alpha' + 'Principal Factors' + ) + TabOrder = 1 + end + object RotateGroup: TRadioGroup + AnchorSideLeft.Control = TypeGroup + AnchorSideTop.Control = TypeGroup + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = TypeGroup + AnchorSideRight.Side = asrBottom + Left = 423 + Height = 156 + Top = 197 + Width = 196 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Top = 12 + Caption = 'Rotation Option' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 136 + ClientWidth = 192 + Items.Strings = ( + 'Varimax' + 'Oblimax' + 'Quartimax' + 'Manual (Graphical)' + 'Procrustian' + 'NO rotation' + ) + TabOrder = 2 + end + end + object OpenDialog1: TOpenDialog + left = 80 + top = 192 + end + object SaveDialog1: TSaveDialog + left = 80 + top = 104 + end +end diff --git a/applications/lazstats/source/forms/analysis/multivariate/factorunit.pas b/applications/lazstats/source/forms/analysis/multivariate/factorunit.pas new file mode 100644 index 000000000..1a6d67f92 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/factorunit.pas @@ -0,0 +1,1580 @@ +unit FactorUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, GraphLib, Globals, MatrixLib, + DataProcs, DictionaryUnit; + +type + + { TFactorFrm } + + TFactorFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + OpenDialog1: TOpenDialog; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + MinRootEdit: TEdit; + MaxItersEdit: TEdit; + MaxFactorsEdit: TEdit; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + SaveCorsBtn: TCheckBox; + SaveDialog1: TSaveDialog; + SaveFactBtn: TCheckBox; + SortBtn: TCheckBox; + ScreeBtn: TCheckBox; + ComUnBtn: TCheckBox; + PlotBtn: TCheckBox; + ScoresBtn: TCheckBox; + DescBtn: TCheckBox; + RMatBtn: TCheckBox; + UnrotBtn: TCheckBox; + PcntTrBtn: TCheckBox; + GroupBox1: TGroupBox; + InBtn: TBitBtn; + OutBtn: TBitBtn; + Label1: TLabel; + Label2: TLabel; + FactorList: TListBox; + RotateGroup: TRadioGroup; + TypeGroup: TRadioGroup; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure FACTORS(VAR eigenvalues : DblDyneVec; + VAR d2 : DblDyneVec; + VAR A : DblDyneMat; + N : integer; + factorchoice : integer); + + procedure factREORDER(VAR d : DblDyneVec; + VAR A : DblDyneMat; + VAR var_label : StrDyneVec; + N : integer); + + procedure SORT_LOADINGS(VAR v : DblDyneMat; + n1, n2 : integer; + VAR High_Factor : IntDyneVec; + VAR A : DblDyneVec; + VAR b : DblDyneVec; + VAR var_label : StrDyneVec; + order : IntDyneVec); + + procedure VARIMAX(VAR v : DblDyneMat; + n1, n2 : integer; + VAR RowLabels : StrDyneVec; + VAR ColLabels : StrDyneVec; + VAR order : IntDyneVec); + + procedure PROCRUST(VAR b : DblDyneMat; + nv, nb : integer; + VAR RowLabels : StrDyneVec; + VAR ColLabels : StrDyneVec); + + procedure LSFactScores(VAR F : DblDyneMat; + NoVars, NoFacts, NCases : integer; + VAR ColNoSelected : IntDyneVec; + VAR RowLabels : StrDyneVec); + + procedure QUARTIMAX(VAR v : DblDyneMat; + n1, n2 : integer; + VAR RowLabels : StrDyneVec; + VAR ColLabels : StrDyneVec; + VAR order : IntDyneVec); + + procedure ManualRotate(VAR v : DblDyneMat; + n1, n2 : integer; + VAR RowLabels : StrDyneVec; + VAR ColLabels : StrDyneVec; + VAR order : IntDyneVec; + Sender : TObject); + + public + { public declarations } + end; + +var + FactorFrm: TFactorFrm; + +implementation + +uses + Math, RotateUnit; + +{ TFactorFrm } + +procedure TFactorFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + FactorList.Clear; + OutBtn.Enabled := false; + InBtn.Enabled := true; + TypeGroup.ItemIndex := 0; + RotateGroup.ItemIndex := 0; + DescBtn.Checked := false; + RMatBtn.Checked := false; + UnrotBtn.Checked := false; + PcntTrBtn.Checked := false; + ScreeBtn.Checked := false; + ComUnBtn.Checked := false; + PlotBtn.Checked := false; + ScoresBtn.Checked := false; + SaveCorsBtn.Checked := false; + SaveFactBtn.Checked := false; + SortBtn.Checked := false; + MinRootEdit.Text := '1'; + MaxItersEdit.Text := '25'; + MaxFactorsEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TFactorFrm.ComputeBtnClick(Sender: TObject); +label again; +var + i, j, k, L, Nroots, noiterations, NoSelected, factorchoice : integer; + maxiters, prtopts, maxnoroots, count : integer; + TempMat, V, corrmat, ainverse, Loadings : DblDyneMat; + Eigenvector, pcnttrace, b, communality, xvector, yvector, d2 : DblDyneVec; + means, variances, stddevs, W : DblDyneVec; + MaxRoot, criterion, Difference, minroot, maxk, trace : double; + cellstring, outline, xtitle, ytitle : string; + ColNoSelected : IntDyneVec; + RowLabels, ColLabels : StrDyneVec; + MatInput : boolean; + Title : string; + filename : string; + Save_Cursor : TCursor; + errorcode : boolean = false; +begin + MaxRoot := 0.0; + noiterations := 0; + maxnoroots := 0; + prtopts := 0; + + criterion := 0.0001; //Convergence of communality estimates + factorchoice := 1; // assume principal component + if (TypeGroup.ItemIndex = 1) then factorchoice := 2; + if (TypeGroup.ItemIndex = 2) then factorchoice := 3; + if (TypeGroup.ItemIndex = 3) then factorchoice := 4; + if (TypeGroup.ItemIndex = 4) then factorchoice := 5; + if (TypeGroup.ItemIndex = 5) then factorchoice := 6; + if (TypeGroup.ItemIndex = 6) then factorchoice := 7; + if (RMatBtn.Checked) then prtopts := 3; + if (RMatBtn.Checked) then prtopts := 2; + if ((RMatBtn.Checked) and (DescBtn.Checked)) then prtopts := 1; + maxiters := StrToInt(MaxItersEdit.Text); + if (MaxFactorsEdit.Text <> '') then + maxnoroots := StrToInt(MaxFactorsEdit.Text); + + // Setup the output + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Factor Analysis'); + OutputFrm.RichEdit.Lines.Add('See Rummel, R.J., Applied Factor Analysis'); + OutputFrm.RichEdit.Lines.Add('Northwestern University Press, 1970'); + OutputFrm.RichEdit.Lines.Add(''); + + if FactorList.Items.Count = 0 then MatInput := true + else begin + NoSelected := FactorList.Items.Count; + MatInput := false; + end; + + // Allocate space on heap + SetLength(corrmat,NoVariables+1,NoVariables+1); + SetLength(TempMat,NoVariables,NoVariables); + SetLength(ainverse,NoVariables,NoVariables); + SetLength(V,NoVariables,NoVariables); + SetLength(W,NoVariables); + SetLength(Loadings,NoVariables,NoVariables); + SetLength(Eigenvector,NoVariables); + SetLength(communality,NoVariables); + SetLength(pcnttrace,NoVariables); + SetLength(b,NoVariables); + SetLength(d2,NoVariables); + SetLength(xvector,NoVariables); + SetLength(yvector,NoVariables); + SetLength(means,NoVariables); + SetLength(variances,NoVariables); + SetLength(stddevs,NoVariables); + SetLength(RowLabels,NoVariables); + SetLength(ColLabels,NoVariables); + SetLength(ColNoSelected,NoVariables); + + if MatInput then // matrix input + begin + OpenDialog1.Filter := 'Matrix files (*.MAT)|*.MAT|All files (*.*)|*.*'; + OpenDialog1.FilterIndex := 1; + OpenDialog1.Title := 'INPUT MATRIX:'; + OpenDialog1.Execute; + filename := OpenDialog1.FileName; + MATREAD(corrmat,NoSelected,NoSelected,means,stddevs,count,RowLabels, + ColLabels,filename); + for i := 1 to NoSelected do + begin + variances[i-1] := sqr(stddevs[i-1]); + FactorList.Items.Add(RowLabels[i-1]); + ColNoSelected[i-1] := i; + end; + NoCases := count; + end + + else + begin + for i := 1 to NoSelected do + begin + cellstring := FactorList.Items.Strings[i-1]; + for j := 1 to NoVariables do + begin + if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then + begin + ColNoSelected[i-1] := j; + ColLabels[i-1] := cellstring; + RowLabels[i-1] := cellstring; + end; + end; + end; + end; + + count := NoCases; + //Obtain correlation matrix and, if required simultaneous Multiple Correlations + if (MatInput = false) then +// Correlate(NoSelected,NoCases,ColNoSelected,means,variances, +// stddevs,corrmat,3,IER,count); + Correlations(NoSelected,ColNoSelected,corrmat,means,variances, + stddevs,errorcode,count); + if RmatBtn.Checked then // print correlation matrix + begin + Title := 'Total Correlation Matrix'; + MAT_PRINT(corrmat,NoSelected,NoSelected,Title,RowLabels, + ColLabels,count); + end; + if DescBtn.Checked then // print descriptives + begin + // print mean, variance and std. dev.s for variables + outline := 'MEANS'; + DynVectorPrint(Means,NoSelected,outline,RowLabels,count); + outline := 'VARIANCES'; + DynVectorPrint(Variances,NoSelected,outline,RowLabels,count); + outline := 'STANDARD DEVIATIONS'; + DynVectorPrint(StdDevs,NoSelected,outline,RowLabels,count); + end; + k := NoSelected; + + // Save correlation matrix if checked + if (SaveCorsBtn.Checked) then + begin + SaveDialog1.Filter := 'Matrix files (*.MAT)|(*.MAT)|All files (*.*)|(*.*)'; + SaveDialog1.FilterIndex := 1; + SaveDialog1.Title := 'SAVE MATRIX:'; + SaveDialog1.Execute; + filename := SaveDialog1.FileName; + MATSAVE(corrmat,NoSelected,NoSelected,means,stddevs,count,RowLabels, + ColLabels,filename); + end; + maxk := k; + Nroots := k; + + if ( factorchoice <> 1) then //not a principal component analysis + begin + //get matrix inverse, squared Multiple Correlations + //Uniqueness (1-squared multiple Correlations, and + //variance of residuals (D squared) + for i := 1 to NoSelected do + for j := 1 to NoSelected do + ainverse[i-1,j-1] := corrmat[i-1,j-1]; + SVDinverse(ainverse,k); + for i := 1 to k do + begin + d2[i-1] := 1.0 / ainverse[i-1,i-1]; + communality[i-1] := 1.0 - d2[i-1]; + end; + + case factorchoice of + 2: begin + outline := 'Partial Image Analysis'; + OutputFrm.RichEdit.Lines.Add(outline); + // Save corrmat in TempMat for temporary use + for i := 1 to k do + for j := 1 to k do TempMat[i-1,j-1] := corrmat[i-1,j-1]; + for i := 1 to k do corrmat[i-1,i-1] := communality[i-1]; + if RmatBtn.Checked then + begin + OutputFrm.RichEdit.Lines.Add('Communality Estimates are Squared Multiple Correlations.'); + Title := 'Partial Image Matrix'; + MAT_PRINT(corrmat,k,k,Title,RowLabels,ColLabels,count); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + end; + 3: begin + outline := 'Guttman Image Analysis'; + OutputFrm.RichEdit.Lines.Add(outline); + //pre and post multiply inverse of R by D2 to obtain anti-image matrix + for i := 1 to k do + for j := 1 to k do + ainverse[i-1,j-1] := d2[i-1] * ainverse[i-1,j-1] * d2[j-1]; + if RmatBtn.Checked then + begin + Title := 'Anti-image covariance matrix'; + MAT_PRINT(ainverse,k,k,Title,RowLabels,ColLabels,count); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + for i := 1 to k do + for j := 1 to k do + corrmat[i-1,j-1] := corrmat[i-1,j-1] + ainverse[i-1,j-1]; + for i := 1 to k do + corrmat[i-1,i-1] := corrmat[i-1,i-1] - (2.0 * d2[i-1]); + if RmatBtn.Checked then + begin + Title := 'Image Covariance Matrix Analyzed'; + MAT_PRINT(corrmat,k,k,Title,RowLabels,ColLabels,count); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + end; + 4: begin + //pre and post multiply inverse of R by D2 to obtain anti-image matrix + for i := 1 to k do + for j := 1 to k do + ainverse[i-1,j-1] := d2[i-1] * ainverse[i-1,j-1] * d2[j-1]; + for i := 1 to k do + for j := 1 to k do + corrmat[i-1,j-1] := corrmat[i-1,j-1] + ainverse[i-1,j-1]; + for i := 1 to k do + corrmat[i-1,i-1] := corrmat[i-1,i-1] - (2.0 * d2[i-1]); + outline := 'Harris Scaled Image Analysis'; + for i := 1 to k do + for j := 1 to k do + corrmat[i-1,j-1] := (1.0 / sqrt(d2[i-1]) * + corrmat[i-1,j-1] * (1.0 / sqrt(d2[j-1]))); + if RmatBtn.Checked then + begin + Title := 'Harris Scaled Image Covariance Matrix'; + MAT_PRINT(corrmat,k,k,Title,RowLabels,ColLabels,count); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + end; + 5: begin + outline := 'Canonical Factor Analysis'; + OutputFrm.RichEdit.Lines.Add(outline); + for i := 1 to k do corrmat[i-1,i-1] := communality[i-1]; + for i := 1 to k do + for j := 1 to k do + corrmat[i-1,j-1] := (1.0 / sqrt(d2[i-1])) * + corrmat[i-1,j-1] * (1.0 / sqrt(d2[j-1])); + if RmatBtn.Checked then + begin + Title := 'Canonical Covariance Matrix'; + MAT_PRINT(corrmat,k,k,Title,RowLabels,ColLabels,count); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + end; + 6: begin + outline := 'Alpha Factor Analysis'; + OutputFrm.RichEdit.Lines.Add(outline); + // Save corrmat in TempMat for temporary use + for i := 1 to k do + for j := 1 to k do TempMat[i-1,j-1] := corrmat[i-1,j-1]; + for i := 1 to k do corrmat[i-1,i-1] := communality[i-1]; + for i := 1 to k do + for j := 1 to k do + corrmat[i-1,j-1] := (1.0 / sqrt(communality[i-1])) * + corrmat[i-1,j-1] * (1.0 / sqrt(communality[j-1])); + if RmatBtn.Checked then + begin + Title := 'Initial Alpha Factor Matrix'; + MAT_PRINT(corrmat,k,k,Title,RowLabels,ColLabels,count); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + end; + 7: begin // Principal Axis Factor Analysis + // Save corrmat in TempMat for temporary use + for i := 1 to k do + for j := 1 to k do TempMat[i-1,j-1] := corrmat[i-1,j-1]; + for i := 1 to k do corrmat[i-1,i-1] := communality[i-1]; + if RmatBtn.Checked then + begin + OutputFrm.RichEdit.Lines.Add('Initial Communality Estimates are Squared Multiple Correlations.'); + Title := 'Principals Axis Factor Analysis Matrix'; + MAT_PRINT(corrmat,k,k,Title,RowLabels,ColLabels,count); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + end; + end; // end case + end // end if factor choice not equal to 1 (Principals Components) + + else + begin + outline := 'Principal Components Analysis'; + OutputFrm.RichEdit.Lines.Add(outline); + if RmatBtn.Checked then + begin + Title := 'Correlation Matrix Factor Analyzed'; + MAT_PRINT(corrmat,k,k,Title,RowLabels,ColLabels,count); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + end; + + //Calculate trace of the matrix to be analyzed + trace := 0.0; + for i := 1 to k do trace := trace + corrmat[i-1,i-1]; + outline := format('Original matrix trace = %6.2f',[trace]); + OutputFrm.RichEdit.Lines.Add(outline); + +again: + for i := 1 to k do + for j := 1 to k do ainverse[i-1,j-1] := corrmat[i-1,j-1]; + eigens(ainverse,Eigenvector,k); + if ((factorchoice = 6)or (factorchoice = 7))then //iteratively solve for communalities + begin + //denormalize eigenvectors + for i := 1 to k do + begin + for j := 1 to k do + begin + if ( Eigenvector[j-1] > 0.0) then + ainverse[i-1,j-1] := ainverse[i-1,j-1] * sqrt(Eigenvector[j-1]) + else + begin + ainverse[i-1,j-1] := 0.0; + Eigenvector[j-1] := 0.0; + end; + end; + b[i-1] := 0.0; + end; + + //get communality estimate from sum of squared loadings in TempMat + for j := 1 to k do + for i := 1 to k do + b[i-1] := b[i-1] + (ainverse[i-1,j-1] * ainverse[i-1,j-1]); + for i := 1 to k do + begin + if (b[i-1] > 1.0) then + begin + b[i-1] := 1.0; + outline := 'WARNING! A communality estimate greater than 1.0 found.'; + OutputFrm.RichEdit.Lines.Add(outline); + outline := 'Value replaced by 1.0. View results with skepticism.'; + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + Difference := 0.0; + for i := 1 to k do Difference := Difference + abs(b[i-1] - communality[i-1]); + if ((Difference > criterion) and (noiterations < maxiters)) then + begin + for i := 1 to k do // restore original r matrix + for j := 1 to k do corrmat[i-1,j-1] := TempMat[i-1,j-1]; + // Place new communalities in the diagonal + for i := 1 to k do corrmat[i-1,i-1] := b[i-1]; + // scale for alpha analysis + if (factorchoice = 6) then + begin + for i := 1 to k do + for j := 1 to k do + corrmat[i-1,j-1] := (1.0 / sqrt(b[i-1])) * + corrmat[i-1,j-1] * (1.0 / sqrt(b[j-1])); + end; + // Save new communality estimates + for i := 1 to k do communality[i-1] := b[i-1]; + noiterations := noiterations + 1; + goto again; + end + + else + begin + if (noiterations >= maxiters) then + begin + outline := format('Factor Analysis failed to converge in %d iterations.',[maxiters]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + factREORDER(Eigenvector,ainverse,RowLabels,k); + end; + end + + else //principal components + begin + FACTORS(Eigenvector, d2, ainverse, k, factorchoice); + factREORDER(Eigenvector, ainverse, RowLabels, k); + end; + Screen.Cursor := Save_Cursor; // restore regular cursor + + for i := 1 to k do + for j := 1 to k do + Loadings[i-1,j-1] := ainverse[i-1,j-1]; + + if (ScreeBtn.Checked) then + begin + SetLength(GraphFrm.Ypoints,1,k); + SetLength(GraphFrm.Xpoints,1,k); + for i := 1 to k do + begin + xvector[i-1] := i; + GraphFrm.Xpoints[0,i-1] := i; + GraphFrm.Ypoints[0,i-1] := Eigenvector[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := k; + GraphFrm.Heading := 'PLOT OF EIGENVALUES EXTRACTED'; + GraphFrm.XTitle := 'ROOT NUMBER'; + GraphFrm.YTitle := 'EIGENVALUE'; +// GraphFrm.Ypoints[1] := Eigenvector; +// GraphFrm.Xpoints[1] := xvector; + GraphFrm.AutoScaled := true; + GraphFrm.PtLabels := false; + GraphFrm.GraphType := 7; // 2d points + GraphFrm.BackColor := clYellow; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + end; + + // Setup labels for factors + for i := 1 to k do + begin + outline := format('Factor %d',[i]); + ColLabels[i-1] := outline; + end; + + //print results if requested + if (UnrotBtn.Checked) then + begin + OutputFrm.RichEdit.Lines.Add('Roots (Eigenvalues) Extracted:'); + for i := 1 to Nroots do + begin + outline := format('%4d %6.3f',[i, Eigenvector[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + outline := 'Unrotated Factor Loadings'; + OutputFrm.RichEdit.Lines.Add(outline); + Title := 'FACTORS'; + MAT_PRINT(Loadings,k,Nroots,Title,RowLabels,ColLabels,count); + OutputFrm.RichEdit.Lines.Add('Percent of Trace In Each Root:'); + for i := 1 to Nroots do + begin + outline := format('%4d Root := %6.3f Trace := %6.3f Percent := %7.3f', + [i, Eigenvector[i-1], trace, (Eigenvector[i-1]/ trace) * 100.0]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + // final communality estimates + trace := 0.0; + for i := 1 to k do + begin + b[i-1] := 0.0; + for j := 1 to Nroots do b[i-1] := b[i-1] + (Loadings[i-1,j-1] * Loadings[i-1,j-1]); + trace := trace + b[i-1]; + end; + + if (ComUnBtn.Checked) then + begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('COMMUNALITY ESTIMATES'); + for i := 1 to k do + begin + outline := format('%3d %-10s %6.3f',[i,RowLabels[i-1],b[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + if ( Nroots > 1) then + begin + minroot := StrToFloat(MinRootEdit.Text); + Nroots := 0; + for i := 1 to k do + if ( Eigenvector[i-1] > minroot) then Nroots := Nroots + 1; + if (maxnoroots = 0) then maxnoroots := Nroots; + if (Nroots > maxnoroots) then Nroots := maxnoroots; + if (RotateGroup.ItemIndex = 0) then + VARIMAX(Loadings, k, Nroots, RowLabels, ColLabels, ColNoSelected); + if (RotateGroup.ItemIndex = 1) then + ShowMessage('Oblimax not available - sorry!'); + if (RotateGroup.ItemIndex = 2) then + QUARTIMAX(Loadings, k, Nroots, RowLabels, ColLabels, ColNoSelected); + if (RotateGroup.ItemIndex = 3) then // graphical (manual) rotation + ManualRotate(Loadings, k, Nroots, RowLabels, ColLabels, ColNoSelected,self); + if (RotateGroup.ItemIndex = 4) then // Procrustean rotation to target + begin // procrustean rotation + PROCRUST(Loadings,k,Nroots,RowLabels,ColLabels); + end; + end; + if (( factorchoice = 6) or (factorchoice = 7)) then + begin + outline := format('No. of iterations := %d',[noiterations]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + + if (( Nroots > 1) and (PlotBtn.Checked)) then + begin + for i := 1 to Nroots - 1 do + begin + for j := i + 1 to Nroots do + begin + for L := 1 to k do + begin + xvector[L-1] := Loadings[L-1,i-1]; + yvector[L-1] := Loadings[L-1,j-1]; + end; + xtitle := format('Factor %d',[i]); + ytitle := format('Factor %d',[j]); + scatplot(xvector, yvector, k, 'FACTOR PLOT', xtitle, + ytitle, -1.0, 1.0, -1.0, 1.0, RowLabels); + end; //Next j + end; //Next i + end; + + // Compute factor scores if checked + if (ScoresBtn.Checked) then + begin + if (MatInput = true) then + ShowMessage('Original subject scores unavailable (matrix input.)') + else LSFactScores(Loadings,k,Nroots,NoCases,ColNoSelected,RowLabels); + end; + + // Save loadings if checked + if (SaveFactBtn.Checked) then + begin + SaveDialog1.Filter := 'Matrix File (*.MAT)|*.MAT|Any File (*.*)|*.*'; + SaveDialog1.FilterIndex := 1; + SaveDialog1.Title := 'Save Factor Loadings'; + SaveDialog1.Execute; + filename := SaveDialog1.FileName; + MATSAVE(Loadings,k,Nroots,means,stddevs,count,RowLabels,ColLabels,filename); + end; + + // Clean up the heap + ColNoSelected := nil; + ColLabels := nil; + RowLabels := nil; + stddevs := nil; + variances := nil; + means := nil; + yvector := nil; + xvector := nil; + d2 := nil; + b := nil; + pcnttrace := nil; + communality := nil; + Eigenvector := nil; + Loadings := nil; + W := nil; + V := nil; + ainverse := nil; + TempMat := nil; + corrmat := nil; + GraphFrm.Ypoints := nil; + GraphFrm.Xpoints := nil; +end; + +procedure TFactorFrm.InBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + FactorList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + OutBtn.Enabled := true; +end; + +procedure TFactorFrm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := FactorList.ItemIndex; + if index < 0 then + begin + OutBtn.Enabled := false; + exit; + end; + VarList.Items.Add(FactorList.Items.Strings[index]); + FactorList.Items.Delete(index); +end; + +procedure TFactorFrm.FACTORS(var eigenvalues: DblDyneVec; var d2: DblDyneVec; + var A: DblDyneMat; N: integer; factorchoice: integer); +var i, j : integer; + +begin + //eigenvalues is the vector of N roots, a is the matrix of column eigenvectors, n is the order of the vector + //and matrix, factorchoice is an integer indicating the type of factor analysis, and d2 is + //a scaling weight for scaled factor analysis types + //The results are the normalized factor loadings returned in a. + + for i := 1 to N do + begin + for j := 1 to N do + begin + if ( eigenvalues[j-1] > 0) then A[i-1,j-1] := A[i-1,j-1] * sqrt(eigenvalues[j-1]) + else A[i-1,j-1] := 0.0; + end; + end; + if ((factorchoice = 4) or (factorchoice = 5)) then + begin + for i := 1 to N do + begin + for j := 1 to N do + begin + if (d2[i-1] > 0) then A[i-1,j-1] := A[i-1,j-1] * sqrt(d2[i-1]) + else A[i-1,j-1] := 0.0; + end; + end; + end; + if ( factorchoice = 6) then //alpha factor analysis + begin + for i := 1 to N do + begin + for j := 1 to N do + begin + if ( eigenvalues[j-1] > 0 ) then A[i-1,j-1] := A[i-1,j-1] * sqrt(1.0 - d2[i-1]) + else A[i-1,j-1] := 0.0; + end; + end; + end; +end; + +procedure TFactorFrm.factREORDER(var d: DblDyneVec; var A: DblDyneMat; + var var_label: StrDyneVec; N: integer); +var + i, j, k : integer; + Temp : double; +begin + // d is the vector of eigenvalues, A is the eigenvalues matrix, + // var_label is the array of variable labels and + // n is the vector and matrix order. + + for i := 1 to N - 1 do + begin + for j := i + 1 to N do + begin + if ( d[i-1] < d[j-1]) then + begin + Temp := d[i-1]; // swap eigenvectors + d[i-1] := d[j-1]; + d[j-1] := Temp; + for k := 1 to N do // swap columns in iegenvector matrix + begin + Temp := A[k-1,i-1]; + A[k-1,i-1] := A[k-1,j-1]; + A[k-1,j-1] := Temp; + end; + end; + end; + end; +end; + +procedure TFactorFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TFactorFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); + if RotateFrm = nil then + Application.CreateForm(TRotateFrm, RotateFrm); +end; + +procedure TFactorFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TFactorFrm.SORT_LOADINGS(var v: DblDyneMat; n1, n2: integer; + var High_Factor: IntDyneVec; var A: DblDyneVec; var b: DblDyneVec; + var var_label: StrDyneVec; order: IntDyneVec); +var + i, j, k, itemp : integer; + NoInFact : IntDyneVec; + maxval, Temp : double; + tempstr : string; + +begin + SetLength(NoInFact,NoVariables); + + // Reorder factors in descending sequence ( left to right ) + for j := 1 to n2 - 1 do + begin // factor j + for k := j + 1 to n2 do + begin // factor k + if ( A[j-1] < A[k-1]) then + begin // variance and factors need swapping + for i := 1 to n1 do + begin // swap factors + Temp := v[i-1,j-1]; + v[i-1,j-1] := v[i-1,k-1]; + v[i-1,k-1] := Temp; + end; + Temp := A[j-1]; // variance swap + A[j-1] := A[k-1]; + A[k-1] := Temp; + end; + end; + end; + // Now select largest loading in each variable + for j := 1 to n2 do NoInFact[j-1] := 0; + for i := 1 to n1 do + begin + High_Factor[i-1] := 0; + maxval := 0.0; + for j := 1 to n2 do + begin + if ( abs(v[i-1,j-1]) > abs(maxval)) then + begin + maxval := abs(v[i-1,j-1]); + High_Factor[i-1] := j; + end; + end; + end; + // Now sort matrix loadings + for i := 1 to n1 - 1 do + begin + for j := i + 1 to n1 do + begin + if ( High_Factor[i-1] > High_Factor[j-1]) then + begin + itemp := High_Factor[i-1]; + High_Factor[i-1] := High_Factor[j-1]; + High_Factor[j-1] := itemp; + for k := 1 to n2 do + begin // loading swap + Temp := v[i-1,k-1]; + v[i-1,k-1] := v[j-1,k-1]; + v[j-1,k-1] := Temp; + end; + tempstr := var_label[i-1]; // label swap + var_label[i-1] := var_label[j-1]; + var_label[j-1] := tempstr; + Temp := b[i-1]; // communality swap + b[i-1] := b[j-1]; + b[j-1] := Temp; + itemp := order[i-1]; + order[i-1] := order[j-1]; + order[j-1] := itemp; + end; + end; + end; + NoInFact := nil; +end; + +procedure TFactorFrm.VARIMAX(var v: DblDyneMat; n1, n2: integer; + var RowLabels: StrDyneVec; var ColLabels: StrDyneVec; var order: IntDyneVec); +label nextone; +var + pi : double; + A, b, C : DblDyneVec; + i, j, k, M, N, minuscount : integer; + High_Factor : IntDyneVec; + a1, b1, c1, c2, c3, c4, d1, x1, x2, Y, s1, Q, TotalPercent, t : double; + outline : string; + Title : string; +begin + pi := 3.14159265358979; + t := n1; + SetLength(A,NoVariables); + SetLength(b,NoVariables); + SetLength(C,NoVariables); + SetLength(High_Factor,NoVariables); + // calculate proportion of variance accounted for by each factor + //before rotation + for j := 1 to n2 do + begin + A[j-1] := 0.0; + for i := 1 to n1 do A[j-1] := A[j-1] + (v[i-1,j-1] * v[i-1,j-1]); + A[j-1] := A[j-1] / t * 100.0; + end; + if (PcntTrBtn.Checked) then + begin + OutputFrm.RichEdit.Lines.Add('Proportion of variance in unrotated factors'); + OutputFrm.RichEdit.Lines.Add(''); + for j := 1 to n2 do + begin + outline := format('%3d %6.3f',[j, A[j-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + end; + for i := 1 to n1 do + begin + b[i-1] := 0.0; + High_Factor[i-1] := 0; + end; + // Reflect factors 180 degrees if more negative than positive loadings + for j := 1 to n2 do + begin + minuscount := 0; + for i := 1 to n1 do + begin + if ( v[i-1,j-1] < 0) then minuscount := minuscount + 1; + end; + if ( minuscount > (n1 / 2)) then + begin + for i := 1 to n1 do v[i-1,j-1] := v[i-1,j-1] * -1.0; + end; + end; + + // normalize rows of v + for i := 1 to n1 do + begin + for j := 1 to n2 do + begin + b[i-1] := b[i-1] + (v[i-1,j-1] * v[i-1,j-1]); + end; + b[i-1] := sqrt(b[i-1]); + for j := 1 to n2 do v[i-1,j-1] := v[i-1,j-1] / b[i-1]; + end; + +nextone: + k := 0; + for M := 1 to n2 do + begin + for N := M to n2 do + begin + if ( M <> N) then // compute angle of rotation + begin + for i := 1 to n1 do + begin + A[i-1] := (v[i-1,M-1] * v[i-1,M-1]) - (v[i-1,N-1] * v[i-1,N-1]); + C[i-1] := 2.0 * v[i-1,M-1] * v[i-1,N-1]; + end; + a1 := 0.0; + for i := 1 to n1 do a1 := a1 + A[i-1]; + b1 := 0.0; + for i := 1 to n1 do b1 := b1 + C[i-1]; + c1 := 0.0; + for i := 1 to n1 do c1 := c1 + (A[i-1] * A[i-1]); + c2 := 0.0; + for i := 1 to n1 do c2 := c2 + (C[i-1] * C[i-1]); + c3 := c1 - c2; + d1 := 0.0; + for i := 1 to n1 do d1 := d1 + A[i-1] * C[i-1]; + d1 := 2 * d1; + x1 := d1 - 2.0 * a1 * b1 / t; + x2 := c3 - ((a1 * a1) - (b1 * b1)) / t; + Y := ArcTan(x1 / x2); + if ( x2 < 0) then + begin + if ( x1 >= 0.0) then Y := Y + 2.0 * pi; + Y := Y - pi; + end; + Y := Y / 4.0; + //if (fabs(Y) >= 0.0175) // rotate pair of axes + if ( abs(Y) >= 0.000001) then + begin + c4 := cos(Y); + s1 := sin(Y); + k := 1; + for i := 1 to n1 do + begin + Q := v[i-1,M-1] * c4 + v[i-1,N-1] * s1; + v[i-1,N-1] := v[i-1,N-1] * c4 - v[i-1,M-1] * s1; + v[i-1,M-1] := Q; + end; + end; // if y + end; // if m <> n + end; // next n + end; // next m + if ( k > 0) then goto nextone; + // denormalize rows of v + for j := 1 to n2 do + begin + for i := 1 to n1 do v[i-1,j-1] := v[i-1,j-1] * b[i-1]; + A[j-1] := 0.0; + for i := 1 to n1 do A[j-1] := A[j-1] + (v[i-1,j-1] * v[i-1,j-1]); + A[j-1] := A[j-1] / t * 100.0; + end; + for i := 1 to n1 do b[i-1] := (b[i-1] * b[i-1]) * 100.0; + if (ComUnBtn.Checked) then + begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Communality Estimates as percentages:'); + for i := 1 to n1 do + begin + outline := format('%3d %6.3f',[i,b[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + end; + if (SortBtn.Checked)then + SORT_LOADINGS(v, n1, n2, High_Factor, A, b, RowLabels, order); + // Reflect factors 180 degrees if more negative than positive loadings + for j := 1 to n2 do + begin + minuscount := 0; + for i := 1 to n1 do + begin + if ( v[i-1,j-1] < 0) then minuscount := minuscount + 1; + end; + if ( minuscount > (n1 / 2)) then + begin + for i := 1 to n1 do v[i-1,j-1] := v[i-1,j-1] * -1.0; + end; + end; + // recalculate proportion of variance accounted for by each factor + for j := 1 to n2 do + begin + A[j-1] := 0.0; + for i := 1 to n1 do A[j-1] := A[j-1] + (v[i-1,j-1] * v[i-1,j-1]); + A[j-1] := A[j-1] / t * 100.0; + end; + // print results + Title := 'Varimax Rotated Loadings'; + MAT_PRINT(v,n1,n2,Title,RowLabels,ColLabels,NoCases); + TotalPercent := 0.0; + OutputFrm.RichEdit.Lines.Add('Percent of Variation in Rotated Factors'); + for j := 1 to n2 do + begin + outline := format('Factor %3d %6.3f', [j,A[j-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + TotalPercent := TotalPercent + A[j-1]; + end; + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Total Percent of Variance in Factors : %6.3f',[TotalPercent]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add('Communalities as Percentages'); + for i := 1 to n1 do + begin + outline := format('%3d for %15s %6.3f',[i, RowLabels[i-1], b[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // clean up heap + High_Factor := nil; + C := nil; + b := nil; + A := nil; +end; + +procedure TFactorFrm.PROCRUST(var b: DblDyneMat; nv, nb: integer; + var RowLabels: StrDyneVec; var ColLabels: StrDyneVec); +label cleanup; +var + i, j, k, na, nf, nd, nv2: integer; + ee, p, sum : double; + A, C, d, v, trans : DblDyneMat; + e, f, g, means, stddevs : DblDyneVec; + outline : string; + Title : string; + ColALabels : StrDyneVec ; + filename : string; + errorcode : boolean = false; + count: Integer = 0; +begin + // nv is the no. of variables, nb the number of factors in the loadings + // matrix. + // na is the number of factors in target matrix + // nf is the no. of roots and vectors extracted from routine sevs + // b is the obtained factor matrix + // A is the target factor matrix + // ColLabels is the set of labels for the obtained factors + // ColALabels is the set of labels for the target factor matrix + Title := 'Source Factor Loadings'; + MAT_PRINT(b,nv,nb,title,RowLabels,ColLabels,NoCases); + nd := nv; + SetLength(A,NoVariables,NoVariables); + SetLength(C,NoVariables,NoVariables); + SetLength(d,NoVariables,NoVariables); + SetLength(v,NoVariables,NoVariables); + SetLength(trans,NoVariables,NoVariables); + SetLength(e,NoVariables); + SetLength(f,NoVariables); + SetLength(g,NoVariables); + SetLength(means,NoVariables); + SetLength(stddevs,NoVariables); + SetLength(ColALabels,NoVariables); + + // read target matrix into A + OpenDialog1.Filter := 'Matrix File (*.MAT)|*.MAT|Any File (*.*)|*.*'; + OpenDialog1.FilterIndex := 1; + OpenDialog1.Title := 'Target Matrix'; + OpenDialog1.DefaultExt := 'MAT'; + OpenDialog1.Execute; + filename := OpenDialog1.FileName; + MATREAD(A,nv2,na,means,stddevs,count,RowLabels,ColALabels,filename); + Title := 'Target Factor Loadings'; + MAT_PRINT(A,nv2,na,Title,RowLabels,ColALabels,count); + if nv2 <> nv then + begin + ShowMessage('ERROR! No. of variables do not match.'); + goto cleanup; + end; + + // normalize matrix A by rows. + for i := 1 to nv do + begin + sum := 0.0; + for j := 1 to na do sum := sum + (A[i-1,j-1] * A[i-1,j-1]); + p := 1.0 / sqrt(sum); + for j := 1 to na do A[i-1,j-1] := A[i-1,j-1] * p; + end; + for i := 1 to nv do // normalize matrix b by rows. Save lengths in g. + begin + sum := 0.0; + for j := 1 to nb do sum := sum + (b[i-1,j-1] * b[i-1,j-1]); + g[i-1] := sqrt(sum); + for j := 1 to nb do b[i-1,j-1] := b[i-1,j-1] / g[i-1]; + end; + // compute cosines between factor axes and print results + // get A transpose x B into C + MATTRN(trans,A,nv,na); + MatAxB(C,trans,b,na,nv,nv,nb,errorcode); + // get D := C x C transpose + MATTRN(trans,C,na,nb); + MatAxB(d,C,trans,na,nb,nb,na,errorcode); + // get roots and vectors of D. + nf := SEVS(na, na, 0.0, d, v, e, f, nd); //nf is new no. of factors returned in na + nb := nf; + // get d := C transpose x V end; + MATTRN(trans,C,na,nb); + MatAxB(d,trans,v,nb,na,na,nb,errorcode); + for j := 1 to nb do + begin + ee := Power(e[j-1],-1.5); + for i := 1 to nb do d[i-1,j-1] := d[i-1,j-1] * ee; + end; + // get D x V' end; + MATTRN(trans,v,na,nb); + MatAxB(C,d,trans,nb,nb,nb,na,errorcode); + OutputFrm.RichEdit.Lines.Add('Factor Pattern Comparison:'); + Title := 'Cosines Among Factor Axis'; + MAT_PRINT(C,na,nb,Title,ColALabels,ColLabels,NoCases); + // get B x C + for i := 1 to nv do + begin + for j := 1 to na do + begin + d[i-1,j-1] := 0.0; + for k := 1 to nb do d[i-1,j-1] := d[i-1,j-1] + (b[i-1,k-1] * C[j-1,k-1]); + end; + end; + for i := 1 to nv do + for j := 1 to na do + v[i-1,j-1] := d[i-1,j-1] * g[i-1]; + Title := 'Factors Rotated to Conguence With Target'; + MAT_PRINT(v,nv,na,Title,RowLabels,ColALabels,NoCases); + for i := 1 to nv do + begin + sum := 0.0; // Get column products of the two matrices + for j := 1 to na do sum := sum + (A[i-1,j-1] * d[i-1,j-1]); + g[i-1] := sum; + end; + OutputFrm.RichEdit.Lines.Add('Cosines (Correlations) Between Corresponding Variables'); + OutputFrm.RichEdit.Lines.Add(''); + for i := 1 to nv do + begin + outline := format('%-10s %8.6f',[RowLabels[i-1],g[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // cleanup +cleanup: + ColALabels := nil; + stddevs := nil; + means := nil; + g := nil; + f := nil; + e := nil; + trans := nil; + v := nil; + d := nil; + C := nil; + A := nil; +end; + +procedure TFactorFrm.LSFactScores(var F: DblDyneMat; NoVars, NoFacts, + NCases: integer; var ColNoSelected: IntDyneVec; var RowLabels: StrDyneVec); +var + R, Rinv, Beta : DblDyneMat; + Means, Variances, StdDevs : DblDyneVec; + Score, Sigma, x, z : double; + i, j, k, m, col, colno, oldnovars : integer; + ColLabels : StrDyneVec; + outline : string; + Title : string; + errcode : boolean = false; + //errorcode: Boolean = false; + +begin + SetLength(R,NoVariables+1,NoVariables+1); + SetLength(Rinv,NoVariables+1,NoVariables+1); + SetLength(Beta,NoVariables,NoVariables); + SetLength(Means,NoVariables); + SetLength(Variances,NoVariables); + SetLength(StdDevs,NoVariables); + SetLength(ColLabels,NoVariables); + + // setup labels and print routine + for i := 1 to NoFacts do + begin + outline := format('Factor %d',[i]); + ColLabels[i-1] := outline; + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('SUBJECT FACTOR SCORE RESULTS:'); + + // Obtain correlations +// Correlate(NoVars,NoCases,ColNoSelected,Means,Variances,StdDevs,R,3,errorcode,NCases); + Correlations(NoVars,ColNoSelected,R,Means,Variances,StdDevs,errcode,NCases); + for i := 1 to NoVars do + for j := 1 to NoVars do + Rinv[i-1,j-1] := R[i-1,j-1]; + + // Get inverse of the correlation matrix + // Note - offset by one for inverse routine + SVDinverse(Rinv, NoVars); + + // Multiply the inverse matrix times the factor loadings matrix + MatAxB(Beta,Rinv,F,NoVars,NoVars,NoVars,NoFacts,errcode); + Title := 'Regression Coefficients'; + MAT_PRINT(Beta,NoVars,NoFacts,Title,RowLabels,ColLabels,NCases); + + // Calculate standard errors of factor scores + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Standard Error of Factor Scores:'); + for i := 1 to NoFacts do + begin + Sigma := 0.0; + for j := 1 to NoVars do + begin + Sigma := Sigma + (Beta[j-1,i-1] * F[j-1,i-1]); + end; + Sigma := sqrt(Sigma); + outline := format('%-10s %6.3f',[ColLabels[i-1],Sigma]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + + //Calculate subject factor scores and place in the data grid + // place labels in new grid columns and define + oldnovars := NoVariables; + for i := 1 to NoFacts do + begin + col := NoVariables + 1; + outline := format('Fact.%d Scr.',[i]); +// MakeVar(col,outline); + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := outline; + OS3MainFrm.DataGrid.Cells[col,0] := outline; +// NoVariables := NoVariables + 1; + end; + for i := 1 to NoCases do // subject + begin + if (not GoodRecord(i,NoVars,ColNoSelected)) then continue; + for j := 1 to NoFacts do // variables + begin + Score := 0.0; + for k := 1 to NoVars do + begin + m := ColNoSelected[k-1]; + x := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[m,i])); + z := (x - Means[k-1]) / StdDevs[k-1]; + Score := Score + (z * Beta[k-1,j-1]); + end; + colno := oldnovars + j; + outline := format('%6.4f',[Score]); + OS3MainFrm.DataGrid.Cells[colno,i] := outline; + end; + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // clean up the heap + ColLabels := nil; + StdDevs := nil; + Variances := nil; + Means := nil; + Beta := nil; + Rinv := nil; + R := nil; +end; + +procedure TFactorFrm.QUARTIMAX(var v: DblDyneMat; n1, n2: integer; + var RowLabels: StrDyneVec; var ColLabels: StrDyneVec; var order: IntDyneVec); +var + i, j, M, N, minuscount, NoIters : integer; + A, b, C : DblDyneVec; + High_Factor : IntDyneVec; + c4, s1, Q, NewQ, TotalPercent, t : double; + theta, tan4theta, ssqrp, ssqrj, prodjp, numerator, denominator : double; + outline : string; + done : boolean; + Title : string; +begin + SetLength(A,NoVariables); + SetLength(b,NoVariables); + SetLength(C,NoVariables); + SetLength(High_Factor,NoVariables); + NoIters := 0; + + // calculate proportion of variance accounted for by each factor + //before rotation + t := n1; + for j := 1 to n2 do + begin + A[j-1] := 0.0; + for i := 1 to n1 do A[j-1] := A[j-1] + (v[i-1,j-1] * v[i-1,j-1]); + A[j-1] := A[j-1] / t * 100.0; + end; + if PcntTrBtn.Checked then + begin + OutputFrm.RichEdit.Lines.Add('Proportion of variance in unrotated factors'); + OutputFrm.RichEdit.Lines.Add(''); + for j := 1 to n2 do + begin + outline := format('%3d %6.3f',[j, A[j-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + end; + for i := 0 to n1-1 do + begin + b[i] := 0.0; + High_Factor[i] := 0; + end; + + // Reflect factors 180 degrees if more negative than positive loadings + for j := 0 to n2-1 do + begin + minuscount := 0; + for i := 0 to n1-1 do + begin + if v[i,j] < 0 then minuscount := minuscount + 1; + end; + if minuscount > (n1 / 2) then + begin + for i := 0 to n1-1 do v[i,j] := v[i,j] * -1.0; + end; + end; + + t := n1; + // normalize rows of v + for i := 0 to n1-1 do + begin + for j := 0 to n2-1 do + begin + b[i] := b[i] + (v[i,j] * v[i,j]); + end; + b[i] := sqrt(b[i]); + end; + + done := false; + Q := 0.0; + for i := 1 to n1 do + for j := 1 to n2 do + Q := Q + Power(v[i-1,j-1],4.0); + while (not done) do + begin + for M := 1 to n2-1 do + begin + for N := M + 1 to n2 do + begin + // compute angle of rotation for this pair of factors + numerator := 0.0; + denominator := 0.0; + for i := 1 to n1 do + begin + ssqrp := v[i-1,M-1] * v[i-1,M-1]; + ssqrj := v[i-1,N-1] * v[i-1,N-1]; + prodjp := 2.0 * v[i-1,M-1] * v[i-1,N-1]; + numerator := numerator + prodjp * (ssqrp - ssqrj); + denominator := denominator + (Power(ssqrp - ssqrj,2.0) - Power(prodjp,2)); + end; + tan4theta := (2.0 * numerator) / denominator; + theta := ArcTan(tan4theta) / 4.0; + c4 := cos(theta); + s1 := sin(theta); + // transform factor loadings + for i := 1 to n1 do + begin + v[i-1,M-1] := v[i-1,M-1] * c4 + v[i-1,N-1] * s1; + v[i-1,N-1] := v[i-1,N-1] * c4 - v[i-1,M-1] * s1; + end; + end; // next n + end; // next m + NewQ := 0.0; + for i := 1 to n1 do + for j := 1 to n2 do + NewQ := NewQ + Power(v[i-1,j-1],4.0); + if (abs(Q - NewQ) < 0.00001) then done := true; + if (n2 < 3) then done := true; + if (not done) then + begin + NoIters := NoIters + 1; + if (NoIters > 25) then + begin + outline := 'Quartimax failed to converge in 25 iterations.'; + OutputFrm.RichEdit.Lines.Add(outline); + done := true; + end; + Q := NewQ; + end; + end; // while not done +{ + // denormalize rows of v + for ( j := 0; j < n2; j++) + begin + for ( i := 0; i < n1; i++) v[i,j] *= b[i]; + A[j] := 0.0; + for ( i := 0; i < n1; i++) A[j] += (v[i,j] * v[i,j]); + A[j] := A[j] / t * 100.0; + end; +} + for i := 1 to n1 do b[i-1] := (b[i-1] * b[i-1]) * 100.0; + if (SortBtn.Checked) then + SORT_LOADINGS(v, n1, n2, High_Factor, A, b, RowLabels, order); + // Reflect factors 180 degrees if more negative than positive loadings + for j := 1 to n2 do + begin + minuscount := 0; + for i := 1 to n1 do + begin + if ( v[i-1,j-1] < 0) then minuscount := minuscount + 1; + end; + if ( minuscount > (n1 / 2)) then + begin + for i := 1 to n1 do v[i-1,j-1] := v[i-1,j-1] * -1.0; + end; + end; + // recalculate proportion of variance accounted for by each factor + for j := 0 to n2-1 do + begin + A[j] := 0.0; + for i := 0 to n1-1 do A[j] := A[j] + (v[i,j] * v[i,j]); + A[j] := A[j] / t * 100.0; + end; + // print results + TotalPercent := 0.0; + Title := 'Quartimax Rotated Loadings'; + MAT_PRINT(v,n1,n2,Title,RowLabels,ColLabels,NoCases); + OutputFrm.RichEdit.Lines.Add('Percent of Variation in Rotated Factors'); + for j := 0 to n2-1 do + begin + outline := format('Factor %3d %6.3f',[j+1,A[j]]); + OutputFrm.RichEdit.Lines.Add(outline); + TotalPercent := TotalPercent + A[j]; + end; + if (ComUnBtn.Checked) then + begin + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Total Percent of Variance in Factors : %6.3f',[TotalPercent]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add('Communalities as Percentages'); + for i := 1 to n1 do + begin + outline := format('%3d for %s %6.3f',[i, RowLabels[i-1], b[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // clean up heap + High_Factor := nil; + C := nil; + b := nil; + A := nil; +end; + +procedure TFactorFrm.ManualRotate(var v: DblDyneMat; n1, n2: integer; + var RowLabels: StrDyneVec; var ColLabels: StrDyneVec; var order: IntDyneVec; + Sender: TObject); +var + cols, rows : integer; + outline : string; + Title : string; + i, j : integer; +begin +// Passed: Loadings, k, Nroots, RowLabels, ColLabels, ColNoSelected,self + SetLength(RotateFrm.Loadings,NoVariables,NoVariables); + RotateFrm.Loadings := v; + RotateFrm.NoVars := n1; + RotateFrm.NoRoots := n2; + RotateFrm.RowLabels := RowLabels; + RotateFrm.ColLabels := ColLabels; + RotateFrm.Order := order; + RotateFrm.ShowModal; + + for i := 1 to n1 do + for j := 1 to n2 do v[i-1,j-1] := RotateFrm.Loadings[i-1,j-1]; + RotateFrm.Loadings := nil; + cols := n2; // no. of roots + rows := n1; // no. of variables + outline := 'Rotated Factor Loadings'; + OutputFrm.RichEdit.Lines.Add(outline); + Title := 'FACTORS'; + MAT_PRINT(v,rows,cols,Title,RowLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; +end; + +initialization + {$I factorunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multivariate/hierarchunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/hierarchunit.lfm new file mode 100644 index 000000000..4eae03343 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/hierarchunit.lfm @@ -0,0 +1,312 @@ +object HierarchFrm: THierarchFrm + Left = 415 + Height = 302 + Top = 211 + Width = 442 + AutoSize = True + Caption = 'Hierarchical Cluster Analysis' + ClientHeight = 302 + ClientWidth = 442 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = PredList + AnchorSideTop.Control = Owner + Left = 228 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Top = 8 + Caption = 'Predictor Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = PredIn + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 228 + Top = 25 + Width = 176 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object PredIn: TBitBtn + AnchorSideTop.Control = VarList + AnchorSideRight.Control = GroupBox1 + Left = 192 + Height = 28 + Top = 25 + Width = 28 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = PredInClick + Spacing = 0 + TabOrder = 1 + end + object PredOut: TBitBtn + AnchorSideLeft.Control = PredIn + AnchorSideTop.Control = PredIn + AnchorSideTop.Side = asrBottom + Left = 192 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = PredOutClick + Spacing = 0 + TabOrder = 2 + end + object PredList: TListBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 228 + Height = 45 + Top = 25 + Width = 206 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + TabOrder = 3 + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = PredIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 228 + Height = 175 + Top = 78 + Width = 206 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Options' + ClientHeight = 155 + ClientWidth = 202 + TabOrder = 4 + object STDChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + Left = 12 + Height = 19 + Top = 2 + Width = 131 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + Caption = 'Standardize Variables' + TabOrder = 0 + end + object ReplaceChk: TCheckBox + AnchorSideLeft.Control = STDChk + AnchorSideTop.Control = STDChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 23 + Width = 123 + BorderSpacing.Top = 2 + Caption = 'Replace Grid Values' + TabOrder = 1 + end + object StatsChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = ReplaceChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 44 + Width = 127 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + Caption = 'Descriptive Statistics' + TabOrder = 2 + end + object PlotChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = StatsChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 65 + Width = 151 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + Caption = 'No. Groups vs Errors Plot' + TabOrder = 3 + end + object MaxGrpsChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = PlotChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 86 + Width = 141 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + Caption = 'Maximum No. Groups:' + TabOrder = 4 + end + object MembersChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = MaxGrpsChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 107 + Width = 151 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + Caption = 'Print Group Membership' + TabOrder = 6 + end + object VarChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = MembersChk + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 128 + Width = 162 + BorderSpacing.Left = 12 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 8 + Caption = 'Cluster Variables, not cases' + TabOrder = 7 + end + object MaxGrps: TEdit + AnchorSideLeft.Control = MaxGrpsChk + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = MaxGrpsChk + AnchorSideTop.Side = asrCenter + Left = 157 + Height = 23 + Top = 84 + Width = 37 + Alignment = taRightJustify + BorderSpacing.Left = 4 + BorderSpacing.Right = 8 + TabOrder = 5 + Text = 'MaxGrps' + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 141 + Height = 25 + Top = 269 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 207 + Height = 25 + Top = 269 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 6 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 281 + Height = 25 + Top = 269 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 7 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 369 + Height = 25 + Top = 269 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 8 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 253 + Width = 442 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/multivariate/hierarchunit.pas b/applications/lazstats/source/forms/analysis/multivariate/hierarchunit.pas new file mode 100644 index 000000000..677587c88 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/hierarchunit.pas @@ -0,0 +1,519 @@ +unit HierarchUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, Globals, MatrixLib, GraphLib, DataProcs; + +type + + { THierarchFrm } + + THierarchFrm = class(TForm) + Bevel1: TBevel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + MaxGrps: TEdit; + STDChk: TCheckBox; + ReplaceChk: TCheckBox; + StatsChk: TCheckBox; + PlotChk: TCheckBox; + MaxGrpsChk: TCheckBox; + MembersChk: TCheckBox; + VarChk: TCheckBox; + GroupBox1: TGroupBox; + PredIn: TBitBtn; + PredOut: TBitBtn; + Label1: TLabel; + Label2: TLabel; + PredList: TListBox; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure PredInClick(Sender: TObject); + procedure PredOutClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + HierarchFrm: THierarchFrm; + +implementation + +uses + Math; + +{ THierarchFrm } + +procedure THierarchFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + PredList.Clear; + PredOut.Enabled := false; + PredIn.Enabled := true; + StdChk.Checked := false; + ReplaceChk.Checked := false; + StatsChk.Checked := false; + PlotChk.Checked := false; + MaxGrpsChk.Checked := false; + VarChk.Checked := false; + MaxGrps.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure THierarchFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + VarList.Constraints.MinWidth := PredList.Width; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure THierarchFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure THierarchFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure THierarchFrm.ComputeBtnClick(Sender: TObject); +label next1; +var + varlabels, rowlabels : StrDyneVec; + outline, cellstring : string; + i, j, k, k1, k3, L, w3, n3, n4, n5, M, col, count: integer; + GrpCnt, Nrows, Ncols, NoSelected, linecount : integer; + w2, k4, k5, L1 : IntDyneVec; + ColSelected : IntDyneVec; + X, Y, d1, x1, MaxError : double; + W, XAxis, YAxis, means, variances, stddevs : DblDyneVec; + Distance : DblDyneMat; +begin + MaxError := 0.0; + GrpCnt := 0; + NoSelected := PredList.Items.Count; + if VarChk.Checked = false then + begin + SetLength(w2,NoCases); + SetLength(k4,NoCases); + SetLength(k5,NoCases); + SetLength(L1,NoCases); + SetLength(W,NoSelected); + SetLength(XAxis,NoCases); + SetLength(YAxis,NoCases); + SetLength(means,NoSelected); + SetLength(variances,NoSelected); + SetLength(stddevs,NoSelected); + SetLength(Distance,NoCases,NoCases); + SetLength(varlabels,NoSelected); + SetLength(rowlabels,NoCases); + SetLength(ColSelected,NoSelected); + Ncols := NoSelected; + Nrows := NoCases; + for i := 0 to Ncols - 1 do + begin + cellstring := PredList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then + begin + varlabels[i] := cellstring; + ColSelected[i] := j; + end; + end; + end; + for i := 0 to NoCases-1 do rowlabels[i] := IntToStr(i); + end + else begin + SetLength(w2,NoSelected); + SetLength(k4,NoSelected); + SetLength(k5,NoSelected); + SetLength(L1,NoSelected); + SetLength(W,NoCases); + SetLength(XAxis,NoSelected); + SetLength(YAxis,NoSelected); + SetLength(means,NoCases); + SetLength(variances,NoCases); + SetLength(stddevs,NoCases); + SetLength(Distance,NoSelected,NoCases); + SetLength(varlabels,NoCases); + SetLength(rowlabels,NoSelected); + SetLength(ColSelected,NoSelected); + Ncols := NoCases; + Nrows := NoSelected; + //Get labels of selected variables + for i := 0 to Nrows - 1 do + begin + cellstring := PredList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then + begin + ColSelected[i] := j; + rowlabels[i] := cellstring; + end; + end; + end; + for i := 0 to NoCases-1 do varlabels[i] := IntToStr(i); + end; + if MembersChk.Checked then k3 := 1 else k3 := 0; + + for j := 0 to Ncols-1 do + begin + means[j] := 0.0; + variances[j] := 0.0; + stddevs[j] := 0.0; + end; + + if VarChk.Checked = false then + begin + // Get labels of rows +// for i := 1 to Nrows do rowlabels[i-1] := MainFrm.Grid.Cells[0,i]; + + // Get data into the distance matrix + count := 0; + for i := 1 to Nrows do + begin + if (not GoodRecord(i,NoSelected,ColSelected)) then continue; + count := count + 1; + for j := 1 to Ncols do + begin + col := ColSelected[j-1]; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); + means[j-1] := means[j-1] + X; + variances[j-1] := variances[j-1] + (X * X); + Distance[i-1,j-1] := X; + end; + end; + end + else begin // cluster variables + // Get labels of columns +// for i := 1 to Nrows do rowlabels[i-1] := MainFrm.Grid.Cells[i,0]; + + // Get data into the distance matrix + count := 0; + for i := 1 to Nrows do // actually grid column in this case + begin +// if (not GoodRecord(i,NoSelected,ColSelected)) then continue; + count := count + 1; + for j := 1 to Ncols do // actually grid rows in this case + begin +// if (not GoodRecord(j,NoSelected,ColSelected)) then continue; + col := ColSelected[i-1]; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,j])); + means[j-1] := means[j-1] + X; + variances[j-1] := variances[j-1] + (X * X); + Distance[i-1,j-1] := X; + end; + end; + end; + + // Calculate means and standard deviations of variables + for j := 0 to Ncols-1 do + begin + variances[j] := variances[j] - (means[j] * means[j] / count); + variances[j] := variances[j] / (count - 1); + stddevs[j] := sqrt(variances[j]); + means[j] := means[j] / count; + end; + + // Ready the output form + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Hierarchical Cluster Analysis'); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Number of objects to cluster := %d on %d variables.', + [Nrows, Ncols]); + OutputFrm.RichEdit.Lines.Add(outline); + linecount := 3; + if (StatsChk.Checked) then + begin + DynVectorPrint(means,Ncols,'Variable Means',varlabels,count); + DynVectorPrint(variances,Ncols,'Variable Variances',varlabels,count); + DynVectorPrint(stddevs,Ncols,'Variable Standard Deviations',varlabels,count); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + linecount := 0; + end; + + // Standardize the distance scores if elected + if (StdChk.Checked) then + begin + for j := 0 to Ncols-1 do + for i := 0 to Nrows-1 do + Distance[i,j] := (Distance[i,j] - means[j]) / stddevs[j]; + end; + + if (ReplaceChk.Checked) then // replace original values in grid with z scores if elected + begin + for i := 1 to Nrows do + begin + if (not GoodRecord(i,NoSelected,ColSelected)) then continue; + for j := 1 to Ncols do + begin + col := ColSelected[j-1]; + outline := format('%6.4f',[Distance[i-1,j-1]]); + OS3MainFrm.DataGrid.Cells[col,i] := outline; + end; + end; + end; + + // Convert data matrix to initial matrix of error potentials + for i := 1 to Nrows do + begin +// if (not GoodRecord(i,NoSelected,ColSelected)) then continue; + for j := 1 to Ncols do W[j-1] := Distance[i-1,j-1]; + for j := i to Nrows do + begin +// if (not GoodRecord(i,NoSelected,ColSelected)) then continue; + Distance[i-1,j-1] := 0.0; + for k := 1 to Ncols do Distance[i-1,j-1] := Distance[i-1,j-1] + + (Distance[j-1,k-1] - W[k-1]) * (Distance[j-1,k-1] - W[k-1]); + Distance[i-1,j-1] := Distance[i-1,j-1] / 2.0; + end; + end; + for i := 1 to Nrows do + for j := i to Nrows do Distance[j-1,i-1] := 0.0; + + // Now, group the cases for maximum groups down + if MaxGrpsChk.Checked then + begin + k1 := StrToInt(MaxGrps.Text); + n3 := Nrows; + end + else begin + k1 := 2; + n3 := Nrows; + end; + + // Initialize group membership and group-n vectors + for i := 0 to Nrows-1 do + begin + k4[i] := i+1; + k5[i] := i+1; + w2[i] := 1; + end; + + // Locate optimal combination, if more than 2 groups remain +next1: + n3 := n3 - 1; + if (n3 > 1) then + begin + x1 := 100000000000.0; + for i := 1 to Nrows do + begin + if (k5[i-1] = i) then + begin + for j := i to Nrows do + begin + if ((i <> j) and (k5[j-1] = j)) then + begin + d1 := Distance[i-1,j-1] - Distance[i-1,i-1] - Distance[j-1,j-1]; + if (d1 < x1) then + begin + x1 := d1; + L := i; + M := j; + end; // end if + end; // end if + end; // next j + end; // end if + end; // next i + n4 := w2[L-1]; + n5 := w2[M-1]; + + OutputFrm.RichEdit.Lines.Add(''); + linecount := linecount + 1; + GrpCnt := GrpCnt + 1; + XAxis[GrpCnt-1] := n3; + YAxis[GrpCnt-1] := x1; + if (x1 > MaxError) then MaxError := x1; + outline := format('%d groups after combining group %d (n := %d ) and group %d (n := %d) error := %7.3f', + [n3, L, n4, M, n5, x1]); + OutputFrm.RichEdit.Lines.Add(outline); + linecount := linecount + 1; + if (linecount >= 60) then + begin + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + linecount := 0; + end; + w3 := w2[L-1] + w2[M-1]; + x1 := Distance[L-1,M-1] * w3; + Y := Distance[L-1,L-1] * w2[L-1] + Distance[M-1,M-1] * w2[M-1]; + Distance[L-1,L-1] := Distance[L-1,M-1]; + for i := 1 to Nrows do + if (k5[i-1] = M) then k5[i-1] := L; + for i := 1 to Nrows do + begin + if ((i <> L) and (k5[i-1] = i)) then + begin + if (i <= L) then + begin + Distance[i-1,L-1] := Distance[i-1,L-1] * (w2[i-1] + w2[L-1]) + + Distance[i-1,M-1] * (w2[i-1] + w2[M-1]) + + x1 - Y - Distance[i-1,i-1] * w2[i-1]; + Distance[i-1,L-1] := Distance[i-1,L-1] / (w2[i-1] + w3); + end + else + begin + Distance[L-1,i-1] := Distance[L-1,i-1] * (w2[L-1] + w2[i-1]) + + (Distance[M-1,i-1] + Distance[i-1,M-1]) * (w2[M-1] + w2[i-1]); + Distance[L-1,i-1] := (Distance[L-1,i-1]+ x1 - Y + - Distance[i-1,i-1] * w2[i-1]) / (w2[i-1] + w3); + end; + end; + end; + w2[L-1] := w3; + if (n3 > k1) then goto next1; + + // print group memberships of all objects, if optioned + for i := 1 to Nrows do + begin + if (k5[i-1] = i) then + begin + L := 0; + for j := 1 to Nrows do + begin + if (k5[j-1] = i) then + begin + L := L + 1; + L1[L-1] := k4[j-1]; + if k3 = 1 then L1[L-1] := j; + end; + end; + if k3 = 1 then + begin + outline := format('Group %d (n := %d)',[i,L]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := ''; + for j := 1 to L do + begin + outline := format(' Object := %s',[rowlabels[L1[j-1]-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + linecount := linecount + 1; + end; + if (linecount >= 60) then + begin + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + linecount := 0; + end; + end; // end if + end; // end if + end; // next i + goto next1; + end; // end if + if (linecount > 0) then OutputFrm.ShowModal; + + if (PlotChk.Checked) then + begin + SetLength(GraphFrm.Ypoints,1,GrpCnt); + SetLength(GraphFrm.Xpoints,1,GrpCnt); + for i := 1 to GrpCnt do + begin + GraphFrm.Ypoints[0,i-1] := YAxis[i-1]; + GraphFrm.Xpoints[0,i-1] := XAxis[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := GrpCnt; + GraphFrm.Heading := 'NO. GROUPS VERSUS GROUPING ERROR'; + GraphFrm.XTitle := 'NO. GROUPS'; + GraphFrm.YTitle := 'ERROR'; +// GraphFrm.Ypoints[1] := YAxis; +// GraphFrm.Xpoints[1] := XAxis; + GraphFrm.AutoScaled := true; + GraphFrm.PtLabels := false; + GraphFrm.GraphType := 7; // 2d points + GraphFrm.BackColor := clYellow; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; +end; + + // clean up + ColSelected := nil; + rowlabels := nil; + varlabels := nil; + Distance := nil; + stddevs := nil; + variances := nil; + means := nil; + YAxis := nil; + XAxis := nil; + W := nil; + L1 := nil; + k5 := nil; + k4 := nil; + w2 := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +procedure THierarchFrm.PredInClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + PredList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + PredOut.Enabled := true; +end; + +procedure THierarchFrm.PredOutClick(Sender: TObject); +VAR index : integer; +begin + index := PredList.ItemIndex; + if index < 0 then + begin + PredOut.Enabled := false; + exit; + end; + VarList.Items.Add(PredList.Items.Strings[index]); + PredList.Items.Delete(index); +end; + +initialization + {$I hierarchunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multivariate/kmeansunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/kmeansunit.lfm new file mode 100644 index 000000000..b163ca5b5 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/kmeansunit.lfm @@ -0,0 +1,429 @@ +object KMeansFrm: TKMeansFrm + Left = 664 + Height = 349 + Top = 318 + Width = 407 + AutoSize = True + Caption = 'k Means Clustering ' + ClientHeight = 349 + ClientWidth = 407 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 106 + Height = 25 + Top = 316 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 172 + Height = 25 + Top = 316 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 4 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 246 + Height = 25 + Top = 316 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 334 + Height = 25 + Top = 316 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 6 + end + object HelpBtn: TButton + Tag = 129 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 43 + Height = 25 + Top = 316 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 2 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 300 + Width = 407 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 101 + Top = 0 + Width = 407 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BevelOuter = bvNone + ClientHeight = 101 + ClientWidth = 407 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = NoClustersEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 12 + Width = 120 + BorderSpacing.Left = 8 + Caption = 'No. of Desired Clusters' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = ItersEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label1 + AnchorSideRight.Side = asrBottom + Left = 43 + Height = 15 + Top = 39 + Width = 85 + Anchors = [akTop, akRight] + Caption = 'No. of Iterations' + ParentColor = False + end + object NoClustersEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + Left = 136 + Height = 23 + Top = 8 + Width = 54 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 0 + Text = 'NoClustersEdit' + end + object ItersEdit: TEdit + AnchorSideLeft.Control = NoClustersEdit + AnchorSideTop.Control = NoClustersEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NoClustersEdit + AnchorSideRight.Side = asrBottom + Left = 136 + Height = 23 + Top = 35 + Width = 54 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 1 + Text = 'ItersEdit' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = NoClustersEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 206 + Height = 93 + Top = 8 + Width = 159 + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Analysis Optons' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 73 + ClientWidth = 155 + TabOrder = 2 + object StdChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 131 + Caption = 'Standardize Variables' + TabOrder = 0 + end + object RepChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 131 + Caption = 'Replace Grid Values' + TabOrder = 1 + end + object DescChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 131 + Caption = 'Descriptive Statistics' + TabOrder = 2 + end + end + end + object Panel2: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 0 + Height = 191 + Top = 109 + Width = 407 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BevelOuter = bvNone + ClientHeight = 191 + ClientWidth = 407 + TabOrder = 1 + object Label3: TLabel + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Panel2 + Left = 8 + Height = 15 + Top = 0 + Width = 97 + BorderSpacing.Left = 8 + Caption = 'Available Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 173 + Top = 18 + Width = 164 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 3 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object VarInBtn: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 189 + Height = 28 + Top = 18 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = VarInBtnClick + Spacing = 0 + TabOrder = 1 + end + object VarOutBtn: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarInBtn + AnchorSideTop.Side = asrBottom + Left = 189 + Height = 28 + Top = 50 + Width = 28 + BorderSpacing.Top = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = VarOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Panel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarOutBtn + AnchorSideTop.Side = asrBottom + Left = 180 + Height = 25 + Top = 102 + Width = 46 + AutoSize = True + BorderSpacing.Top = 24 + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 3 + end + object ListBox1: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 234 + Height = 173 + Top = 18 + Width = 165 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 3 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 4 + end + object Label4: TLabel + AnchorSideLeft.Control = ListBox1 + AnchorSideTop.Control = Panel2 + Left = 234 + Height = 15 + Top = 0 + Width = 93 + Caption = 'Selected Variables' + ParentColor = False + end + end +end diff --git a/applications/lazstats/source/forms/analysis/multivariate/kmeansunit.pas b/applications/lazstats/source/forms/analysis/multivariate/kmeansunit.pas new file mode 100644 index 000000000..1eba95662 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/kmeansunit.pas @@ -0,0 +1,905 @@ +unit KMeansUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, DataProcs, OutputUnit, ContextHelpUnit; + +type + + { TKMeansFrm } + + TKMeansFrm = class(TForm) + Bevel1: TBevel; + DescChkBox: TCheckBox; + HelpBtn: TButton; + Panel1: TPanel; + Panel2: TPanel; + VarInBtn: TBitBtn; + VarOutBtn: TBitBtn; + AllBtn: TBitBtn; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + StdChkBox: TCheckBox; + RepChkBox: TCheckBox; + GroupBox1: TGroupBox; + ItersEdit: TEdit; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + ListBox1: TListBox; + VarList: TListBox; + NoClustersEdit: TEdit; + Label1: TLabel; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarInBtnClick(Sender: TObject); + procedure VarOutBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure KMNS(VAR A : DblDyneMat; M, N : integer; + VAR C : DblDyneMat; K : integer; VAR IC1 : IntDyneVec; + VAR IC2 : IntDyneVec; VAR NC : IntDyneVec; + VAR AN1 : DblDyneVec; VAR AN2 : DblDyneVec; + VAR NCP : IntDyneVec; VAR D : DblDyneVec; + VAR ITRAN : IntDyneVec; VAR LIVE : IntDyneVec; + ITER : integer; VAR WSS : DblDyneVec; IFAULT : integer); + procedure OPTRA(VAR A : DblDyneMat; M, N : integer; + VAR C : DblDyneMat; K : integer; + VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec; + VAR NC : IntDyneVec; VAR AN1 : DblDyneVec; + VAR AN2 : DblDyneVec; VAR NCP : IntDyneVec; + VAR D : DblDyneVec; VAR ITRAN : IntDyneVec; + VAR LIVE : IntDyneVec; INDX : integer); + procedure QTRAN(VAR A : DblDyneMat; M, N : integer; + VAR C : DblDyneMat; K : integer; + VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec; + VAR NC : IntDyneVec; VAR AN1 : DblDyneVec; + VAR AN2 : DblDyneVec; VAR NCP : IntDyneVec; + VAR D : DblDyneVec; VAR ITRAN : IntDyneVec; + INDX : integer); + + public + { public declarations } + end; + +var + KMeansFrm: TKMeansFrm; + +implementation + +uses + Math; + +{ TKMeansFrm } + +procedure TKMeansFrm.ResetBtnClick(Sender: TObject); +VAR cellstring : string; + i : integer; +begin + VarList.Clear; + ListBox1.Clear; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + VarList.Items.Add(cellstring); + end; + RepChkBox.Checked := false; + StdChkBox.Checked := true; + VarOutBtn.Enabled := false; + DescChkBox.Checked := false; + NoClustersEdit.Text := ''; + ItersEdit.Text := '100'; +end; + +procedure TKMeansFrm.VarInBtnClick(Sender: TObject); +VAR + index, count, i : integer; + cellstring : string; +begin + count := 0; + index := ListBox1.Items.Count; + for i := 0 to index - 1 do + begin + if (VarList.Selected[i]) then + begin + cellstring := VarList.Items.strings[i]; + ListBox1.Items.Add(cellstring); + count := count + 1; + end; + end; + + while (count > 0) do + begin + for i := 0 to VarList.Items.Count - 1 do + begin + if (VarList.Selected[i]) then + begin + VarList.Items.Delete(i); + count := count - 1; + end; + end; + end; + VarOutBtn.Enabled := true; +end; + +procedure TKMeansFrm.VarOutBtnClick(Sender: TObject); +VAR index : integer; + cellstring : string; +begin + index := ListBox1.ItemIndex; + cellstring := ListBox1.Items.Strings[index]; + VarList.Items.Add(cellstring); + ListBox1.Items.Delete(index); +end; + +procedure TKMeansFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TKMeansFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TKMeansFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TKMeansFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TKMeansFrm.AllBtnClick(Sender: TObject); +VAR + index, noitems : integer; + cellstring : string; +begin + noitems := VarList.Items.Count; + for index := 0 to noitems - 1 do + begin + cellstring := VarList.Items.Strings[index]; + ListBox1.Items.Add(cellstring); + end; + VarList.Clear; + VarOutBtn.Enabled := true; +end; + +procedure TKMeansFrm.ComputeBtnClick(Sender: TObject); +VAR + i, j, L, Ncols, N, M, K,IFAULT, ITER, col : integer; + center, itemp : integer; + IC1, IC2, NC, NCP, ITRAN, LIVE, ColSelected : IntDyneVec; + A, C : DblDyneMat; + D, AN1, AN2, WSS, DT : DblDyneVec; + cellstring: string; + outline : string; + strval : string; + varlabels, rowlabels : StrDyneVec; + Mean, stddev : double; +label cleanup; + +begin + Ncols := ListBox1.Items.Count; + if (Ncols <= 0) then + begin + ShowMessage('ERROR! No variables selected to cluster.'); + exit; + end; + + N := Ncols; + M := NoCases; + K := StrToInt(NoClustersEdit.Text); + IFAULT := 0; + ITER := StrToInt(ItersEdit.Text); + + SetLength(varlabels,Ncols); + SetLength(rowlabels,NoCases); + SetLength(ColSelected,Ncols); + SetLength(A,M+1,N+1); + SetLength(C,K+1,N+1); + SetLength(D,M+1); + SetLength(AN1,K+1); + SetLength(AN2,K+1); + SetLength(WSS,K+1); + SetLength(DT,3); + SetLength(IC1,M+1); + SetLength(IC2,M+1); + SetLength(NC,K+1); + SetLength(NCP,K+1); + SetLength(ITRAN,K+1); + SetLength(LIVE,K+1); + + if (K <= 0) then + begin + ShowMessage('ERROR! You must enter the desired number of clusters.'); + goto cleanup; + end; + + // initialize arrays + for i := 1 to K do + begin + AN1[i] := 0.0; + AN2[i] := 0.0; + WSS[i] := 0.0; + NC[i] := 0; + NCP[i] := 0; + ITRAN[i] := 0; + LIVE[i] := 0; + for j := 1 to N do C[i,j] := 0.0; + end; + for i := 1 to M do + begin + IC1[i] := 0; + IC2[i] := 0; + D[i] := 0.0; + end; + + //Get labels and columns of selected variables + for i := 0 to Ncols - 1 do + begin + cellstring := ListBox1.Items.Strings[i]; + for j := 0 to NoVariables - 1 do + begin + if (cellstring = OS3MainFrm.DataGrid.Cells[j+1,0]) then + begin + varlabels[i] := cellstring; + ColSelected[i] := j+1; + end; + end; + end; + + // Get labels of rows + for i := 0 to NoCases - 1 do rowlabels[i] := OS3MainFrm.DataGrid.Cells[0,i+1]; + + // read the data + for i := 1 to M do + begin + if (NOT GoodRecord(i,N,ColSelected)) then continue; + for j := 1 to N do + begin + col := ColSelected[j-1]; + A[i,j] := StrToFloat(OS3MainFrm.DataGrid.Cells[col,i]); + end; + end; + + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('K-Means Clustering. Adapted from AS 136 APPL. STATIST. (1979) VOL.28, NO.1'); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('File := %s',[OS3MainFrm.FileNameEdit.Text]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('No. Cases := %d, No. Variables := %d, No. Clusters := %d',[M,N,K]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + // transform to z scores if needed + if (StdChkBox.Checked = true) then + begin + for j := 1 to N do + begin + Mean := 0.0; + stddev := 0.0; + for i := 1 to M do + begin + Mean := Mean + A[i,j]; + stddev := stddev + (A[i,j] * A[i,j]); + end; + stddev := stddev - Mean * Mean / M; + stddev := stddev / (M - 1); + Mean := Mean / M; + if (DescChkBox.Checked) then + begin + outline := format('Mean := %8.3f, Std.Dev. := %8.3f for %s',[Mean,stddev,varlabels[j-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + for i := 1 to M do + begin + A[i,j] := (A[i,j] - Mean) / stddev; + if (RepChkBox.Checked = true) then + begin + col := ColSelected[j-1]; + outline := format('%8.5f',[A[i,j]]); + OS3MainFrm.DataGrid.Cells[col,i] := outline; + end; + end; + end; + end; + + // Now enter initial points + for L := 1 to K do + begin + center := 1 + (L-1) * (M div K); // initial cluster center + for j := 1 to N do C[L,j] := A[center,j]; + end; + + // do analysis + KMNS(A,M,N,C,K,IC1,IC2,NC,AN1,AN2,NCP,D,ITRAN,LIVE,ITER,WSS,IFAULT); + + // show results + + // sort subjects by cluster + for i := 1 to M do IC2[i] := i; // store ids in here + for i := 1 to M - 1 do + begin + for j := i+1 to M do + begin + if (IC1[i] > IC1[j]) then // swap these clusters and ids + begin + itemp := IC1[i]; + IC1[i] := IC1[j]; + IC1[j] := itemp; + itemp := IC2[i]; + IC2[i] := IC2[j]; + IC2[j] := itemp; + end; + end; + end; + + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('NUMBER OF SUBJECTS IN EACH CLUSTER'); + for i := 1 to K do + begin + outline := format('Cluster := %d with %d cases.',[i,NC[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('PLACEMENT OF SUBJECTS IN CLUSTERS'); + OutputFrm.RichEdit.Lines.Add('CLUSTER SUBJECT'); + for i := 1 to M do + begin + outline := format(' %3d %3d',[IC1[i],IC2[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('AVERAGE VARIABLE VALUES BY CLUSTER'); + outline := ' VARIABLES'; + OutputFrm.RichEdit.Lines.Add(outline); + outline := 'CLUSTER'; + for j := 1 to N do + begin + strval := format(' %3d ',[j]); + outline := outline + strval; + end; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(' '); + for i := 1 to K do + begin + outline := format(' %3d ',[i]); + for j := 1 to N do + begin + strval := format('%5.2f ',[C[i,j]]); + outline := outline + strval; + end; + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('WITHIN CLUSTER SUMS OF SQUARES'); + for i := 1 to K do + begin + outline := format('Cluster %d := %6.3f',[i,WSS[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + + OutputFrm.ShowModal; + + // cleanup +cleanup: + LIVE := nil; + ITRAN := nil; + NCP := nil; + NC := nil; + IC2 := nil; + IC1 := nil; + DT := nil; + WSS := nil; + AN2 := nil; + AN1 := nil; + D := nil; + C := nil; + A := nil; + ColSelected := nil; + rowlabels := nil; + varlabels := nil; +end; + +procedure TKMeansFrm.KMNS(VAR A : DblDyneMat; M, N : integer; + VAR C : DblDyneMat; K : integer; VAR IC1 : IntDyneVec; + VAR IC2 : IntDyneVec; VAR NC : IntDyneVec; + VAR AN1 : DblDyneVec; VAR AN2 : DblDyneVec; + VAR NCP : IntDyneVec; VAR D : DblDyneVec; + VAR ITRAN : IntDyneVec; VAR LIVE : IntDyneVec; + ITER : integer; VAR WSS : DblDyneVec; IFAULT : integer); +VAR + DT : array[0..2] of double; + BIG : double; + ZERO : double; + ONE : double; + DA, DB, DC, TEMP, AA : double; + L, II, INDX, I, J, IL, IJ : integer; +label cont50, cont40, cont150; + +begin + // SUBROUTINE KMNS(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, + // * ITRAN, LIVE, ITER, WSS, IFAULT) + // + // ALGORITHM AS 136 APPL. STATIST. (1979) VOL.28, NO.1 + // Divide M points in N-dimensional space into K clusters so that + // the within cluster sum of squares is minimized. + // + // INTEGER IC1(M), IC2(M), NC(K), NCP(K), ITRAN(K), LIVE(K) + // REAL A(M,N), D(M), C(K,N), AN1(K), AN2(K), WSS(K), DT(2) + // REAL ZERO, ONE + // + // Define BIG to be a very large positive number + // + // DATA BIG /1.E30/, ZERO /0.0/, ONE /1.0/ + // + BIG := 1.0e30; + ZERO := 0.0; + ONE := 1.0; + IFAULT := 3; + if ((K <= 1) or (K >= M)) then + begin + ShowMessage('The no. of clusters must be less than the no. of variables.'); + exit; + end; + + // For each point I, find its two closest centres, IC1(I) and + // IC2(I). Assign it to IC1(I). + // + for I := 1 to M do + begin + IC1[I] := 1; + IC2[I] := 2; + for IL := 1 to 2 do + begin + DT[IL] := ZERO; + for J := 1 to N do + begin + DA := A[I,J] - C[IL,J]; + DT[IL] := DT[IL] + (DA * DA); //(squared difference for this comparison) + end; // 10 CONTINUE + end; // 10 CONTINUE + if (DT[1] > DT[2]) then // THEN swap + begin + IC1[I] := 2; + IC2[I] := 1; + TEMP := DT[1]; + DT[1] := DT[2]; + DT[2] := TEMP; + end; // END IF + for L := 3 to K do // (remaining clusters) + begin + DB := ZERO; + for J := 1 to N do // (variables) + begin + DC := A[I,J] - C[L,J]; + DB := DB + DC * DC; + if (DB >= DT[2]) then goto cont50; + end; + if (DB < DT[1]) then goto cont40; + DT[2] := DB; + IC2[I] := L; + goto cont50; +cont40: DT[2] := DT[1]; + IC2[I] := IC1[I]; + DT[1] := DB; + IC1[I] := L; +cont50: end; + end; // 50 CONTINUE (next case) + + // Update cluster centres to be the average of points contained + // within them. + // + for L := 1 to K do // (clusters) + begin + NC[L] := 0; + for J := 1 to N do C[L,J] := ZERO; //(initialize clusters) + end; + for I := 1 to M do // (subjects) + begin + L := IC1[I]; // which cluster the Ith case is in + NC[L] := NC[L] + 1; // no. in the cluster L + for J := 1 to N do C[L,J] := C[L,J] + A[I,J]; // sum of var. values in the cluster L + end; + + // Check to see if there is any empty cluster at this stage + // + for L := 1 to K do + begin + if (NC[L] = 0) then + begin + IFAULT := 1; + exit; + end; + AA := NC[L]; + for J := 1 to N do C[L,J] := C[L,J] / AA; // average the values in the cluster + + // Initialize AN1, AN2, ITRAN & NCP + // AN1(L) := NC(L) / (NC(L) - 1) + // AN2(L) := NC(L) / (NC(L) + 1) + // ITRAN(L) := 1 if cluster L is updated in the quick-transfer stage, + // := 0 otherwise + // In the optimal-transfer stage, NCP(L) stores the step at which + // cluster L is last updated. + // In the quick-transfer stage, NCP(L) stores the step at which + // cluster L is last updated plus M. + // + AN2[L] := AA / (AA + ONE); + AN1[L] := BIG; + if (AA > ONE) then AN1[L] := AA / (AA - ONE); + ITRAN[L] := 1; + NCP[L] := -1; + end; + INDX := 0; + for IJ := 1 to ITER do + begin + // + // In this stage, there is only one pass through the data. Each + // point is re-allocated, if necessary, to the cluster that will + // induce the maximum reduction in within-cluster sum of squares. + // + OPTRA(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, ITRAN, LIVE, INDX); + // + // Stop if no transfer took place in the last M optimal transfer + // steps. + // + if (INDX = M) then goto cont150; + // + // Each point is tested in turn to see if it should be re-allocated + // to the cluster to which it is most likely to be transferred, + // IC2(I), from its present cluster, IC1(I). Loop through the + // data until no further change is to take place. + // + QTRAN(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, ITRAN, INDX); + // + // If there are only two clusters, there is no need to re-enter the + // optimal transfer stage. + // + if (K = 2) then goto cont150; + // + // NCP has to be set to 0 before entering OPTRA. + // + for L := 1 to K do NCP[L] := 0; + end; + // + // Since the specified number of iterations has been exceeded, set + // IFAULT := 2. This may indicate unforeseen looping. + // + IFAULT := 2; + // + // Compute within-cluster sum of squares for each cluster. + // +cont150: + for L := 1 to K do + begin + WSS[L] := ZERO; + for J := 1 to N do C[L,J] := ZERO; + end; + for I := 1 to M do + begin + II := IC1[I]; + for J := 1 to N do C[II,J] := C[II,J] + A[I,J]; + end; + for J := 1 to N do + begin + for L := 1 to K do C[L,J] := C[L,J] / (NC[L]); + for I := 1 to M do + begin + II := IC1[I]; + DA := A[I,J] - C[II,J]; + WSS[II] := WSS[II] + DA * DA; + end; + end; // 190 CONTINUE +end; + + +procedure TKMeansFrm.OPTRA(VAR A : DblDyneMat; M, N : integer; + VAR C : DblDyneMat; K : integer; + VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec; + VAR NC : IntDyneVec; VAR AN1 : DblDyneVec; + VAR AN2 : DblDyneVec; VAR NCP : IntDyneVec; + VAR D : DblDyneVec; VAR ITRAN : IntDyneVec; + VAR LIVE : IntDyneVec; INDX : integer); +VAR + ZERO, ONE, BIG,DE, DF, DD, DC, DB, DA, R2, RR, AL1, AL2, ALT, ALW : double; + I, J, L, L1, L2, LL : integer; +label cont30, cont60, cont70, cont90; + +begin + // SUBROUTINE OPTRA(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, + // * ITRAN, LIVE, INDX) + // + // ALGORITHM AS 136.1 APPL. STATIST. (1979) VOL.28, NO.1 + // + // This is the optimal transfer stage. + // + // Each point is re-allocated, if necessary, to the cluster that + // will induce a maximum reduction in the within-cluster sum of + // squares. + // + // INTEGER IC1(M), IC2(M), NC(K), NCP(K), ITRAN(K), LIVE(K) + // REAL A(M,N), D(M), C(K,N), AN1(K), AN2(K), ZERO, ONE + // + // Define BIG to be a very large positive number. + // + // DATA BIG /1.0E30/, ZERO /0.0/, ONE/1.0/ + // + // If cluster L is updated in the last quick-transfer stage, it + // belongs to the live set throughout this stage. Otherwise, at + // each step, it is not in the live set if it has not been updated + // in the last M optimal transfer steps. + // + + ZERO := 0.0; + ONE := 1.0; + BIG := 1.0e30; + + for L := 1 to K do + begin + if (ITRAN[L] = 1) then LIVE[L] := M + 1; + end; // 10 CONTINUE + + for I := 1 to M do + begin + INDX := INDX + 1; + L1 := IC1[I]; + L2 := IC2[I]; + LL := L2; + // + // If point I is the only member of cluster L1, no transfer. + // + if (NC[L1] = 1) then goto cont90; // GO TO 90 + // + // If L1 has not yet been updated in this stage, no need to + // re-compute D(I). + // + if (NCP[L1] = 0) then goto cont30; // GO TO 30 + DE := ZERO; + for J := 1 to N do + begin + DF := A[I,J] - C[L1,J]; + DE := DE + DF * DF; + end; + D[I] := DE * AN1[L1]; + // + // Find the cluster with minimum R2. + // +cont30: + DA := ZERO; + for J := 1 to N do + begin + DB := A[I,J] - C[L2,J]; + DA := DA + DB * DB; + end; + R2 := DA * AN2[L2]; + for L := 1 to K do + begin + // + // If I >:= LIVE(L1), then L1 is not in the live set. If this is + // true, we only need to consider clusters that are in the live set + // for possible transfer of point I. Otherwise, we need to consider + // all possible clusters. + // + if ((I >= LIVE[L1]) and (I >= LIVE[L]) or (L = L1) or (L = LL)) then goto cont60; + RR := R2 / AN2[L]; + DC := ZERO; + for J := 1 to N do + begin + DD := A[I,J] - C[L,J]; + DC := DC + DD * DD; + if (DC >= RR) then goto cont60; + end; + R2 := DC * AN2[L]; + L2 := L; +cont60: + end; // 60 CONTINUE + if (R2 < D[I]) then goto cont70; + // + // If no transfer is necessary, L2 is the new IC2(I). + // + IC2[I] := L2; + goto cont90; // GO TO 90 + // + // Update cluster centres, LIVE, NCP, AN1 & AN2 for clusters L1 and + // L2, and update IC1(I) & IC2(I). + // +cont70: + INDX := 0; + LIVE[L1] := M + I; + LIVE[L2] := M + I; + NCP[L1] := I; + NCP[L2] := I; + AL1 := NC[L1]; + ALW := AL1 - ONE; + AL2 := NC[L2]; + ALT := AL2 + ONE; + for J := 1 to N do + begin + C[L1,J] := (C[L1,J] * AL1 - A[I,J]) / ALW; + C[L2,J] := (C[L2,J] * AL2 + A[I,J]) / ALT; + end; + NC[L1] := NC[L1] - 1; + NC[L2] := NC[L2] + 1; + AN2[L1] := ALW / AL1; + AN1[L1] := BIG; + if (ALW > ONE) then AN1[L1] := ALW / (ALW - ONE); + AN1[L2] := ALT / AL2; + AN2[L2] := ALT / (ALT + ONE); + IC1[I] := L2; + IC2[I] := L1; +cont90: + // 90 CONTINUE + if (INDX = M) then exit; + end; // 100 CONTINUE + for L := 1 to K do + begin + // + // ITRAN(L) := 0 before entering QTRAN. Also, LIVE(L) has to be + // decreased by M before re-entering OPTRA. + // + ITRAN[L] := 0; + LIVE[L] := LIVE[L] - M; + end; // 110 CONTINUE +end; + +procedure TKMeansFrm.QTRAN(VAR A : DblDyneMat; M, N : integer; + VAR C : DblDyneMat; K : integer; + VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec; + VAR NC : IntDyneVec; VAR AN1 : DblDyneVec; + VAR AN2 : DblDyneVec; VAR NCP : IntDyneVec; + VAR D : DblDyneVec; VAR ITRAN : IntDyneVec; + INDX : integer); +VAR + BIG, ZERO, ONE, DA, DB, DE, DD, R2, AL1, ALW, AL2, ALT : double; + I, J, ICOUN, ISTEP, L1, L2 : integer; +label cont10, cont30, cont60; + +begin + // SUBROUTINE QTRAN(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, + // * ITRAN, INDX) + // + // ALGORITHM AS 136.2 APPL. STATIST. (1979) VOL.28, NO.1 + // + // This is the quick transfer stage. + // IC1(I) is the cluster which point I belongs to. + // IC2(I) is the cluster which point I is most likely to be + // transferred to. + // For each point I, IC1(I) & IC2(I) are switched, if necessary, to + // reduce within-cluster sum of squares. The cluster centres are + // updated after each step. + // + // INTEGER IC1(M), IC2(M), NC(K), NCP(K), ITRAN(K) + // REAL A(M,N), D(M), C(K,N), AN1(K), AN2(K), ZERO, ONE + // + // Define BIG to be a very large positive number + // + // DATA BIG /1.0E30/, ZERO /0.0/, ONE /1.0/ + // + // In the optimal transfer stage, NCP(L) indicates the step at which + // cluster L is last updated. In the quick transfer stage, NCP(L) + // is equal to the step at which cluster L is last updated plus M. + // + BIG := 1.0e30; + ZERO := 0.0; + ONE := 1.0; + ICOUN := 0; + ISTEP := 0; +cont10: + for I := 1 to M do + begin + ICOUN := ICOUN + 1; + ISTEP := ISTEP + 1; + L1 := IC1[I]; + L2 := IC2[I]; + // + // If point I is the only member of cluster L1, no transfer. + // + if (NC[L1] = 1) then goto cont60; + // + // If ISTEP > NCP(L1), no need to re-compute distance from point I to + // cluster L1. Note that if cluster L1 is last updated exactly M + // steps ago, we still need to compute the distance from point I to + // cluster L1. + // + if (ISTEP > NCP[L1]) then goto cont30; + DA := ZERO; + for J := 1 to N do + begin + DB := A[I,J] - C[L1,J]; + DA := DA + DB * DB; + end; + D[I] := DA * AN1[L1]; + // + // If ISTEP >:= both NCP(L1) & NCP(L2) there will be no transfer of + // point I at this step. + // +cont30: + if ((ISTEP >= NCP[L1]) and (ISTEP >= NCP[L2])) then goto cont60; + R2 := D[I] / AN2[L2]; + DD := ZERO; + for J := 1 to N do + begin + DE := A[I,J] - C[L2,J]; + DD := DD + DE * DE; + if (DD >= R2) then goto cont60; + end; // 40 CONTINUE + // + // Update cluster centres, NCP, NC, ITRAN, AN1 & AN2 for clusters + // L1 & L2. Also update IC1(I) & IC2(I). Note that if any + // updating occurs in this stage, INDX is set back to 0. + // + ICOUN := 0; + INDX := 0; + ITRAN[L1] := 1; + ITRAN[L2] := 1; + NCP[L1] := ISTEP + M; + NCP[L2] := ISTEP + M; + AL1 := NC[L1]; + ALW := AL1 - ONE; + AL2 := NC[L2]; + ALT := AL2 + ONE; + for J := 1 to N do + begin + C[L1,J] := (C[L1,J] * AL1 - A[I,J]) / ALW; + C[L2,J] := (C[L2,J] * AL2 + A[I,J]) / ALT; + end; // 50 CONTINUE + NC[L1] := NC[L1] - 1; + NC[L2] := NC[L2] + 1; + AN2[L1] := ALW / AL1; + AN1[L1] := BIG; + if (ALW > ONE) then AN1[L1] := ALW / (ALW - ONE); + AN1[L2] := ALT / AL2; + AN2[L2] := ALT / (ALT + ONE); + IC1[I] := L2; + IC2[I] := L1; + // + // If no re-allocation took place in the last M steps, return. + // +cont60: + if (ICOUN = M) then exit; + end; // 70 CONTINUE + goto cont10; +end; + +initialization + {$I kmeansunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multivariate/medianpolishunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/medianpolishunit.lfm new file mode 100644 index 000000000..d7713a69f --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/medianpolishunit.lfm @@ -0,0 +1,383 @@ +object MedianPolishForm: TMedianPolishForm + Left = 638 + Height = 408 + Top = 340 + Width = 462 + AutoSize = True + Caption = 'Median Polishing for a Two-Way Table' + ClientHeight = 408 + ClientWidth = 462 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 161 + Height = 25 + Top = 375 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 100 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 227 + Height = 25 + Top = 375 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 4 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 301 + Height = 25 + Top = 375 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 389 + Height = 25 + Top = 375 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 6 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 359 + Width = 462 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = NormChk + Left = 0 + Height = 340 + Top = 0 + Width = 462 + Anchors = [akTop, akLeft, akRight, akBottom] + BevelOuter = bvNone + ClientHeight = 340 + ClientWidth = 462 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 8 + Height = 15 + Top = 8 + Width = 49 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = DepIn1 + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 309 + Top = 23 + Width = 201 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + TabOrder = 0 + end + object DepVar: TEdit + AnchorSideLeft.Control = DepIn1 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOut + AnchorSideBottom.Side = asrBottom + Left = 253 + Height = 23 + Top = 48 + Width = 201 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 4 + Text = 'DepVar' + end + object DepIn1: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 217 + Height = 28 + Top = 23 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepIn1Click + Spacing = 0 + TabOrder = 1 + end + object DepOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepIn1 + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 28 + Top = 55 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutClick + Spacing = 0 + TabOrder = 3 + end + object Fact1In: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepOut + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 28 + Top = 107 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Fact1InClick + Spacing = 0 + TabOrder = 5 + end + object Fact1Out: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Fact1In + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 28 + Top = 139 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Fact1OutClick + Spacing = 0 + TabOrder = 6 + end + object Fact2In: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Fact1Out + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 28 + Top = 191 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Fact2InClick + Spacing = 0 + TabOrder = 8 + end + object Fact2Out: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Fact2In + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 28 + Top = 222 + Width = 28 + BorderSpacing.Top = 3 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Fact2OutClick + Spacing = 0 + TabOrder = 9 + end + object Factor1: TEdit + AnchorSideLeft.Control = Fact1In + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Fact1Out + AnchorSideBottom.Side = asrBottom + Left = 253 + Height = 23 + Top = 132 + Width = 201 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 7 + Text = 'Edit1' + end + object Factor2: TEdit + AnchorSideLeft.Control = Fact2In + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Fact2Out + AnchorSideBottom.Side = asrBottom + Left = 253 + Height = 23 + Top = 215 + Width = 201 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 10 + Text = 'Edit1' + end + object Label4: TLabel + AnchorSideLeft.Control = Fact2Out + AnchorSideTop.Control = Fact2Out + AnchorSideTop.Side = asrBottom + Left = 217 + Height = 15 + Top = 274 + Width = 81 + BorderSpacing.Top = 24 + Caption = 'Max. Iterations:' + ParentColor = False + end + object MaxEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrCenter + Left = 306 + Height = 23 + Top = 270 + Width = 35 + BorderSpacing.Left = 8 + TabOrder = 11 + Text = '5' + end + object StaticText1: TStaticText + AnchorSideLeft.Control = DepVar + AnchorSideBottom.Control = DepVar + Left = 253 + Height = 15 + Top = 31 + Width = 73 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + TabOrder = 2 + end + object Label2: TLabel + AnchorSideLeft.Control = Factor1 + AnchorSideBottom.Control = Factor1 + Left = 253 + Height = 15 + Top = 115 + Width = 42 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Factor 1' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Factor2 + AnchorSideBottom.Control = Factor2 + Left = 253 + Height = 15 + Top = 198 + Width = 42 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Factor 2' + ParentColor = False + end + end + object ItersBtn: TRadioButton + AnchorSideLeft.Control = NormChk + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NormChk + AnchorSideTop.Side = asrCenter + Left = 258 + Height = 19 + Top = 340 + Width = 182 + BorderSpacing.Left = 16 + BorderSpacing.Right = 8 + Caption = 'Show Results for Each Iteration' + TabOrder = 2 + Visible = False + end + object NormChk: TCheckBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 19 + Top = 340 + Width = 234 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + Caption = 'Show Bill Miller''s Normalizing Procedure' + TabOrder = 1 + end +end diff --git a/applications/lazstats/source/forms/analysis/multivariate/medianpolishunit.pas b/applications/lazstats/source/forms/analysis/multivariate/medianpolishunit.pas new file mode 100644 index 000000000..923e1dd7c --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/medianpolishunit.pas @@ -0,0 +1,950 @@ +unit MedianPolishUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, FunctionsLib, OutputUnit, GraphLib; + +type + + { TMedianPolishForm } + + TMedianPolishForm = class(TForm) + Bevel1: TBevel; + NormChk: TCheckBox; + MaxEdit: TEdit; + Label4: TLabel; + ItersBtn: TRadioButton; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + DepIn1: TBitBtn; + DepOut: TBitBtn; + DepVar: TEdit; + Fact1In: TBitBtn; + Fact1Out: TBitBtn; + Fact2In: TBitBtn; + Fact2Out: TBitBtn; + Factor1: TEdit; + Factor2: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + StaticText1: TStaticText; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure DepIn1Click(Sender: TObject); + procedure DepOutClick(Sender: TObject); + procedure Fact1InClick(Sender: TObject); + procedure Fact1OutClick(Sender: TObject); + procedure Fact2InClick(Sender: TObject); + procedure Fact2OutClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + + private + { private declarations } + FAutoSized: boolean; + CumRowResiduals : DblDyneVec; + CumColResiduals : DblDyneVec; + function Median(VAR X : DblDyneVec; size : integer) : double; + procedure PrintObsTable(ObsTable : DblDyneMat; nrows, ncols : integer); + procedure PrintResults(ObsTable : DblDyneMat; rowmedian,rowresid : DblDyneVec; + comedian, colresid : DblDyneVec; nrows, ncols : integer); + procedure sortvalues(VAR X : DblDyneVec; size : integer); + procedure TwoWayPlot(NF1cells : integer; RowSums : DblDyneVec; + graphtitle : string; Heading : string); + procedure InteractPlot(NF1cells, NF2Cells : integer; + ObsTable :DblDyneMat; graphtitle : string; + Heading : string); + public + { public declarations } + end; + +var + MedianPolishForm: TMedianPolishForm; + +implementation + +uses + Math; + +{ TMedianPolishForm } + +procedure TMedianPolishForm.ResetBtnClick(Sender: TObject); +var i : integer; +begin + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + DepVar.Text := ''; + Factor1.Text := ''; + Factor2.Text := ''; + DepIn1.Enabled := true; + DepOut.Enabled := false; + Fact1In.Enabled := true; + Fact1Out.Enabled := false; + Fact2In.Enabled := true; + Fact2out.Enabled := false; + ItersBtn.Checked := false; + NormChk.Checked := false; +end; + +procedure TMedianPolishForm.ComputeBtnClick(Sender: TObject); +VAR + NoSelected, DepVarCol, F1Col, F2Col, i, j, k : integer; + minrow, maxrow, mincol, maxcol : integer; + intvalue, xrange, yrange, row, col, N, count, iteration : integer; + X, M, sumrowmedians, sumcolmedians, GrandMedian, scale, TotResid : double; + SumAbsRows, SumAbsCols, SumAbsTable, TableSum, explained : double; + Q1, Q3, Qrange1, Qrange2, total : double; + ColNoSelected : IntDyneVec; + Observed : DblDyneCube; + Residuals : DblDyneCube; + RowResiduals : DblDyneVec; + ColResiduals : DblDyneVec; + RowMedian : DblDyneVec; + ColMedian : DblDyneVec; + CellCount : IntDyneMat; + GroupScores : DblDyneVec; + ObsTable : DblDyneMat; + cellstring : string; + single : boolean; + NoIterations : integer; + done : boolean; + WholeTable : DblDyneVec; + RowEffects : DblDyneVec; + ColEffects : DblDyneVec; +begin + OutputFrm.RichEdit.Clear; + for i := 1 to NoVariables do + begin + cellstring := Trim(OS3MainFrm.DataGrid.Cells[i,0]); + if cellstring = DepVar.Text then DepVarCol := i; + if cellstring = Factor1.Text then F1Col := i; + if cellstring = Factor2.Text then F2Col := i; + end; + NoSelected := 3; + SetLength(ColNoSelected,3); + ColNoSelected[0] := DepVarCol; + ColNoSelected[1] := F1Col; + ColNoSelected[2] := F2Col; + // get no. of rows and columns (Factor 1 and Factor 2) + mincol := 10000; + maxcol := 0; + minrow := 10000; + maxrow := 0; + for i := 1 to NoCases do + begin + intvalue := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i])); + if intvalue > maxrow then maxrow := intvalue; + if intvalue < minrow then minrow := intvalue; + intvalue := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[F2Col,i])); + if intvalue > maxcol then maxcol := intvalue; + if intvalue < mincol then mincol := intvalue; + end; + xrange := maxrow - minrow + 1; + yrange := maxcol - mincol + 1; + // get no. of observations in each cell + SetLength(CellCount,xrange,yrange); + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + CellCount[i,j] := 0; + end; + end; + count := 0; + single := false; + for i := 1 to NoCases do + begin + row := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i])); + row := row - minrow; + col := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[F2Col,i])); + col := col - mincol; + CellCount[row,col] := CellCount[row,col] + 1; + count := count + 1; + end; + if count = (xrange * yrange) then single := true; + SetLength(Observed,NoCases,xrange,yrange); + SetLength(Residuals,NoCases,xrange,yrange); + SetLength(RowResiduals,xrange); + SetLength(ColResiduals,yrange); + SetLength(GroupScores,NoCases); + SetLength(RowMedian,xrange); + SetLength(ColMedian,yrange); + SetLength(CumRowResiduals,xrange); + SetLength(CumColResiduals,yrange); + SetLength(WholeTable,xrange * yrange); + SetLength(RowEffects,xrange); + SetLength(ColEffects,yrange); + + for i := 0 to NoCases-1 do + begin + for j := 0 to xrange-1 do + begin + for k := 0 to yrange-1 do + begin + Observed[i,j,k] := 0.0; + Residuals[i,j,k] := 0.0; + end; + end; + end; + for j := 0 to xrange-1 do + begin + RowResiduals[j] := 0.0; + CumRowResiduals[j] := 0.0; + end; + for j := 0 to yrange-1 do + begin + ColResiduals[j] := 0.0; + CumColResiduals[j] := 0.0; + end; + // Get observed scores + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + CellCount[i,j] := 0; + end; + end; + for i := 1 to NoCases do + begin + row := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i])); + row := row - minrow; + col := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[F2Col,i])); + col := col - mincol; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepVarCol,i])); + CellCount[row,col] := CellCount[row,col] + 1; + N := CellCount[row,col]; + Observed[N-1,row,col] := X; + end; + + // if not single case in each cell, obtain median for each cell + if not single then + begin + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + for k := 0 to CellCount[i,j]-1 do + begin + GroupScores[k] := Observed[k,i,j]; + end; + M := Median(GroupScores,CellCount[i,j]); + Observed[0,i,j] := M; + end; + end; + end; + SetLength(ObsTable,xrange,yrange); + k := 0; + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + ObsTable[i,j] := Observed[0,i,j]; + WholeTable[k] := Observed[0,i,j]; + k := k + 1; + end; + end; + sortvalues(WholeTable,xrange*yrange); + Q1 := Quartiles(2,0.25,xrange*yrange,WholeTable); + Q3 := Quartiles(2,0.75,xrange*yrange,WholeTable); + Qrange1 := Q3 - Q1; + cellstring := format('Quartiles of original data = %8.3f %8.3f',[Q1,Q3]); + OutputFrm.RichEdit.Lines.Add(cellstring); + + if NormChk.Checked = true then + begin + // Bill Miller's solution + // get deviations of each cell from the grand mean, row and column residuals + // and row and column absolute deviations + k := 0; + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + ObsTable[i,j] := Observed[0,i,j]; + WholeTable[k] := Observed[0,i,j]; + k := k + 1; + end; + end; + sortvalues(WholeTable,xrange*yrange); + M := Median(WholeTable,xrange*yrange); + GrandMedian := M; +// OutputFrm.RichEdit.Clear; + cellstring := Format('Grand Median = %9.3f',[M]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + PrintObsTable(ObsTable,xrange,yrange); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + for i := 0 to xrange-1 do + begin + RowMedian[i] := 0.0; + RowResiduals[i] := 0.0; + CumRowResiduals[i] := 0.0; + end; + for j := 0 to yrange-1 do + begin + ColMedian[j] := 0.0; + ColResiduals[j] := 0.0; + CumColResiduals[j] := 0.0; + end; + + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + GroupScores[j] := ObsTable[i,j]; + end; + sortvalues(GroupScores,yrange); + M := Median(GroupScores,yrange); + RowMedian[i] := M; + end; + + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + RowResiduals[i] := RowResiduals[i] + (ObsTable[i,j] - RowMedian[i]); + end; + CumRowResiduals[i] := CumRowResiduals[i] + abs(RowResiduals[i]); + end; + + for j := 0 to yrange-1 do + begin + for i := 0 to xrange-1 do + begin + GroupScores[i] := ObsTable[i,j]; + end; + sortvalues(GroupScores,xrange); + M := Median(GroupScores,xrange); + ColMedian[j] := M; + end; + + for j := 0 to yrange-1 do + begin + for i := 0 to xrange-1 do + begin + ColResiduals[j] := ColResiduals[j] + (ObsTable[i,j] - ColMedian[j]); + end; + CumColResiduals[j] := CumColResiduals[j] + abs(ColResiduals[j]); + end; + PrintResults(ObsTable,RowMedian,RowResiduals,ColMedian,ColResiduals,xrange,yrange); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; +// TwoWayPlot(xrange, RowMedian,'Rows','ROW MEDIANS'); +// TwoWayPlot(yrange, ColMedian,'Columns','COL. MEDIANS'); + // Normalize medians and raw data + // This will result in the sum of column, row and table residuals all + // summing to zero. The model is X = Total Median + Row effects + + // col. effects + interaction effects and the row, col and interaction + // effects each sum to zero (as in ANOVA) + TableSum := 0.0; + scale := 0; + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + scale := scale + ObsTable[i,j]; + end; + end; + scale := scale / (xrange * yrange); + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + ObsTable[i,j] := ObsTable[i,j] - scale; + TableSum := TableSum + abs(ObsTable[i,j]); + end; + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Normalized Data'); + PrintObsTable(ObsTable,xrange,yrange); + scale := 0; + for i := 0 to xrange-1 do scale := scale + RowMedian[i]; + scale := scale / xrange; + for i := 0 to xrange-1 do RowMedian[i] := RowMedian[i] - scale; + scale := 0; + for j := 0 to yrange-1 do scale := scale + ColMedian[j]; + scale := scale / yrange; + for j := 0 to yrange-1 do ColMedian[j] := ColMedian[j] - scale; + + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Normalized Adjusted Data'); + PrintResults(ObsTable,RowMedian,RowResiduals,ColMedian,ColResiduals,xrange,yrange); + OutputFrm.RichEdit.Lines.Add(''); + + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + ObsTable[i,j] := ObsTable[i,j] - (RowMedian[i] + ColMedian[j]); + end; + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Normalized Table minus Row and Column Medians'); + PrintObsTable(ObsTable,xrange,yrange); + for i := 0 to xrange-1 do RowResiduals[i] := 0.0; + for j := 0 to yrange-1 do ColResiduals[j] := 0.0; + TotResid := 0.0; + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + RowResiduals[i] := RowResiduals[i] + ObsTable[i,j]; + ColResiduals[j] := ColResiduals[j] + ObsTable[i,j]; + TotResid := TotResid + ObsTable[i,j]; + end; + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Normalized Adjusted Data'); + PrintResults(ObsTable,RowMedian,RowResiduals,ColMedian,ColResiduals,xrange,yrange); + OutputFrm.RichEdit.Lines.Add(''); + cellstring := format('Total Table Residuals = %8.3f',[TotResid]); + OutputFrm.RichEdit.Lines.Add(cellstring); + + SumAbsRows := 0.0; + SumAbsCols := 0.0; + SumAbsTable := 0.0; + for i := 0 to xrange-1 do SumAbsRows := SumAbsRows + abs(RowMedian[i]); + for j := 0 to yrange-1 do SumAbsCols := SumAbsCols + abs(ColMedian[j]); + for i := 0 to xrange - 1 do + for j := 0 to yrange - 1 do + SumAbsTable := SumAbsTable + abs(ObsTable[i,j]); + cellstring := format('Absolute Sums of Row, Col and Interactions = %8.3f %8.3f %8.3f', + [SumAbsRows, SumAbsCols, SumAbsTable]); + OutputFrm.RichEdit.Lines.Add(cellstring); + total := SumAbsRows + SumAbsCols + SumAbsTable; + cellstring := format('Absolute Sums of Table Values prior to Extracting Row and Col. = %8.3f', + [TableSum]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('Percentages explained by rows, col.s, interactions plus error %8.3f %8.3f %8.3f', + [100*SumAbsRows/total, 100*SumAbsCols/total, 100*SumAbsTable/total]); + OutputFrm.RichEdit.Lines.Add(cellstring); + explained := 100*SumAbsRows/total + 100*SumAbsCols/total + 100*SumAbsTable/total; + cellstring := format('Percentage explained = %8.3f percent',[explained]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + TwoWayPlot(xrange, RowMedian,'Rows','ROW MEDIANS'); + TwoWayPlot(yrange, ColMedian,'Columns','COL. MEDIANS'); + end; // Bills method + + // Now do traditional median smoothing + OutputFrm.RichEdit.Lines.Add('Tukey Iterative Median Smoothing Method'); + OutputFrm.RichEdit.Lines.Add(''); + NoIterations := StrToInt(MaxEdit.Text); + done := false; + iteration := 1; + for i := 0 to xrange-1 do RowEffects[i] := 0.0; + for j := 0 to yrange-1 do ColEffects[j] := 0.0; + while not done do + begin + // Get residuals from the median for each row + count := 0; + for i := 0 to xrange-1 do + begin + count := 0; + for j := 0 to yrange-1 do + begin + GroupScores[count] := Observed[0,i,j]; + count := count + 1; + end; + sortvalues(GroupScores,count); + M := Median(GroupScores,count); + RowMedian[i] := M; + for j := 0 to yrange-1 do Observed[0,i,j] := Observed[0,i,j] - M; + for j := 0 to yrange-1 do RowResiduals[i] := RowResiduals[i] + Observed[0,i,j]; + CumRowResiduals[i] := CumRowResiduals[i] + abs(RowResiduals[i]); + end; + + // get sum of residuals for cols + count := 0; + for i := 0 to yrange-1 do + begin + count := 0; + for j := 0 to xrange-1 do + begin + GroupScores[count] := Observed[0,j,i]; + count := count + 1; + end; + sortvalues(GroupScores,count); + M := Median(GroupScores,count); + ColMedian[i] := M; + for j := 0 to xrange-1 do Observed[0,j,i] := Observed[0,j,i] - M; + for j := 0 to xrange-1 do ColResiduals[i] := ColResiduals[i] + Observed[0,j,i]; + CumColResiduals[i] := CumColResiduals[i] + abs(ColResiduals[i]); + end; + + // build table of results + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + ObsTable[i,j] := Observed[0,i,j]; // Residuals[0,i,j]; + end; + end; + +// if ItersBtn.Checked then +// begin + OutputFrm.RichEdit.Lines.Add(''); + cellstring := format('Iteration = %d',[iteration]); + OutputFrm.RichEdit.Lines.Add(cellstring); + PrintResults(ObsTable,RowMedian,RowResiduals,ColMedian,ColResiduals,xrange,yrange); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Row Effects'); + for i := 0 to xrange-1 do + begin + GroupScores[i] := RowMedian[i]; + end; + sortvalues(GroupScores,xrange); + M := Median(GroupScores,xrange); + cellstring := format('Overall Median = %8.3f',[m]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.RichEdit.Lines.Add(''); + for i := 0 to xrange-1 do + begin + RowEffects[i] := RowEffects[i] + (RowMedian[i] - M); + cellstring := format('Row %d Effect = %8.3f',[i+1,RowEffects[i]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Column Effects'); + for j := 0 to yrange-1 do + begin + ColEffects[j] := ColEffects[j] + ColMedian[j]; + cellstring := format('Col. %d Effect = %8.3f',[j+1,ColEffects[j]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; +// OutputFrm.ShowModal; +// OutputFrm.RichEdit.Clear; +// end; + for i := 0 to xrange-1 do RowResiduals[i] := 0.0; + for j := 0 to yrange-1 do ColResiduals[j] := 0.0; + NoIterations := NoIterations - 1; + iteration := iteration + 1; + if NoIterations = 0 then done := true; + sumrowmedians := 0.0; + sumcolmedians := 0.0; + for i := 0 to xrange-1 do sumrowmedians := sumrowmedians + RowMedian[i]; + for i := 0 to yrange-1 do sumcolmedians := sumcolmedians + ColMedian[i]; + if (sumrowmedians + sumcolmedians) = 0.0 then done := true; + if done then + begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('SUMMARY OF THE ANALYSIS'); + PrintResults(ObsTable,RowMedian,RowResiduals,ColMedian,ColResiduals,xrange,yrange); + for i := 0 to xrange-1 do + begin + RowEffects[i] := RowEffects[i] + (RowMedian[i] - M); + cellstring := format('Row %d Effect = %8.3f',[i+1,RowEffects[i]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Column Effects'); + for j := 0 to yrange-1 do + begin + ColEffects[j] := ColEffects[j] + ColMedian[j]; + cellstring := format('Col. %d Effect = %8.3f',[j+1,ColEffects[j]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; + k := 0; + OutputFrm.RichEdit.Lines.Add(''); + for i := 0 to xrange-1 do + begin + for j := 0 to yrange-1 do + begin + WholeTable[k] := ObsTable[i,j]; + k := k + 1; + end; + end; + sortvalues(WholeTable,xrange*yrange); + M := Median(WholeTable,xrange*yrange); + Q1 := Quartiles(2,0.25,xrange*yrange,WholeTable); + Q3 := Quartiles(2,0.75,xrange*yrange,WholeTable); + cellstring := format('Quartiles of the residuals = %8.3f %8.3f', + [Q1, Q3]); + OutputFrm.RichEdit.Lines.Add(cellstring); + Qrange2 := Q3 - Q1; + cellstring := format('Original interquartile and final interquartile ranges = %8.3f %8.3f', + [Qrange1, Qrange2]); + OutputFrm.RichEdit.Lines.Add(cellstring); + cellstring := format('Quality of the additive fit = %8.3f percent', + [100 * (Qrange1 - Qrange2) / Qrange1]); + OutputFrm.RichEdit.Lines.Add(cellstring); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + end; // while not done +// if ItersBtn.Checked then +// begin + TwoWayPlot(xrange, RowEffects,'Rows','CUMULATIVE ROW EFFECTS'); + TwoWayPlot(yrange, ColEffects,'Columns','CUMULATIVE COL. EFFECTS'); + InteractPlot(xrange, yrange, ObsTable, 'Interaction', + 'RESIDUALS OF ROWS AND COLUMNS'); +// end; + // cleanup + ColEffects := nil; + RowEffects := nil; + WholeTable := nil; + CumColResiduals := nil; + CumRowResiduals := nil; + ObsTable := nil; + ColMedian := nil; + RowMedian := nil; + GroupScores := nil; + CellCount := nil; + ColResiduals := nil; + RowResiduals := nil; + Residuals := nil; + Observed := nil; + ColNoSelected := nil; +end; + +procedure TMedianPolishForm.DepIn1Click(Sender: TObject); +var index : integer; +begin + index := VarList.ItemIndex; + DepVar.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + DepIn1.Enabled := false; + DepOut.Enabled := true;; +end; + +procedure TMedianPolishForm.DepOutClick(Sender: TObject); +begin + VarList.Items.Add(DepVar.Text); + DepVar.Text := ''; + DepIn1.Enabled := true; + DepOut.Enabled := false; +end; + +procedure TMedianPolishForm.Fact1InClick(Sender: TObject); +var index : integer; +begin + index := VarList.ItemIndex; + Factor1.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + Fact1In.Enabled := false; + Fact1Out.Enabled := true;; +end; + +procedure TMedianPolishForm.Fact1OutClick(Sender: TObject); +begin + VarList.Items.Add(Factor1.Text); + Factor1.Text := ''; + Fact1In.Enabled := true; + Fact1Out.Enabled := false; +end; + +procedure TMedianPolishForm.Fact2InClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + Factor2.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + Fact2In.Enabled := false; + Fact2Out.Enabled := true;; +end; + +procedure TMedianPolishForm.Fact2OutClick(Sender: TObject); +begin + VarList.Items.Add(Factor2.Text); + Factor2.Text := ''; + Fact2In.Enabled := true; + Fact2Out.Enabled := false; +end; + +procedure TMedianPolishForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TMedianPolishForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +function TMedianPolishForm.Median(VAR X : DblDyneVec; size : integer) : double; +var + midpt : integer; + value : double; +begin +(* check for correct median calculation + OutputFrm.RichEdit.Lines.Add('Sorted values to get median'); + cellstring := format('size of array = %d',[size]); + OutputFrm.RichEdit.Lines.Add(cellstring); + for i := 0 to size do + begin + cellstring := format('no. %d = %9.3f',[i+1,X[i]]); + OutputFrm.RichEdit.Lines.Add(cellstring); + end; +*) + if size > 2 then + begin + midpt := size div 2; + if 2 * midpt = size then // even no. of values + begin + value := (X[midpt-1] + X[midpt]) / 2; + end + else value := X[midpt]; // odd no. of values + Median := value; + end + else if size = 2 then Median := (X[0] + X[1]) / 2; +// cellstring := format('Median = %9.3f',[value]); +// OutputFrm.ShowModal; +end; + +procedure TMedianPolishForm.PrintObsTable(ObsTable : DblDyneMat; nrows, ncols : integer); +VAR + cellstring, outline : string; + i, j : integer; +begin + outline := 'Observed Data'; + OutputFrm.RichEdit.Lines.Add(outline); + outline := 'ROW COLUMNS'; + OutputFrm.RichEdit.Lines.Add(outline); + outline := ' '; + for i := 1 to ncols do + begin + outline := outline + format('%10d',[i]); + end; + OutputFrm.RichEdit.Lines.Add(outline); + for i := 1 to nrows do + begin + outline := format('%3d ',[i]); + for j := 1 to ncols do + begin + cellstring := format('%9.3f ',[ObsTable[i-1,j-1]]); + outline := outline + cellstring; + end; + OutputFrm.RichEdit.Lines.Add(outline); + end; +end; + + procedure TMedianPolishForm.PrintResults(ObsTable : DblDyneMat; + rowmedian,rowresid : DblDyneVec; + comedian, colresid : DblDyneVec; nrows, ncols : integer); +var + i, j : integer; + cellstring, outline : string; +begin + OutputFrm.RichEdit.Lines.Add(''); + outline := 'Adjusted Data'; + OutputFrm.RichEdit.Lines.Add(outline); + outline := 'MEDIAN'; + for i := 1 to ncols do + begin + outline := outline + format('%10d',[i]); + end; + outline := outline + ' Residuals'; + OutputFrm.RichEdit.Lines.Add(outline); + outline := '---------------------------------------------------------'; + OutputFrm.RichEdit.Lines.Add(outline); + for i := 0 to nrows-1 do + begin + cellstring := format('%9.3f ',[rowmedian[i]]); + outline := cellstring; + for j := 0 to ncols-1 do + begin + cellstring := format('%9.3f ',[ObsTable[i,j]]); + outline := outline + cellstring; + end; + cellstring := format('%9.3f ',[rowresid[i]]); + outline := outline + cellstring; + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := '---------------------------------------------------------'; + OutputFrm.RichEdit.Lines.Add(outline); + cellstring := 'Col.Resid.'; + outline := cellstring; + for j := 0 to ncols-1 do + begin + cellstring := format('%9.3f ',[colresid[j]]); + outline := outline + cellstring; + end; + OutputFrm.RichEdit.Lines.Add(outline); + cellstring := 'Col.Median'; + outline := cellstring; + for j := 0 to ncols-1 do + begin + cellstring := format('%9.3f ',[comedian[j]]); + outline := outline + cellstring; + end; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Cumulative absolute value of Row Residuals'); + for j := 0 to nrows-1 do + begin + outline := format('Row = %d Cum.Residuals = %9.3f',[j+1,CumRowResiduals[j]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Cumulative absolute value of Column Residuals'); + for j := 0 to ncols-1 do + begin + outline := format('Column = %d Cum.Residuals = %9.3f',[j+1,CumColResiduals[j]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; +end; + +procedure TMedianPolishForm.sortvalues(VAR X : DblDyneVec; size : integer); +VAR + i, j : integer; + temp : double; +begin + for i := 0 to size-2 do + begin + for j := i+1 to size-1 do + begin + if X[i] > X[j] then // swap + begin + temp := X[i]; + X[i] := X[j]; + X[j] := temp; + end; + end; + end; +// OutputFrm.RichEdit.Lines.Add('Sorted values'); +// for i := 0 to size-1 do +// begin +// cellstring := format('no. %d = %9.3f',[i+1,X[i]]); +// OutputFrm.RichEdit.Lines.Add(cellstring); +// end; +// OutputFrm.RichEdit.Lines.Add(''); +end; +//----------------------------------------------------------------------- +procedure TMedianPolishForm.TwoWayPlot(NF1cells : integer; + RowSums : DblDyneVec; graphtitle : string; Heading : string); +var + i: integer; + minmean, maxmean: double; + XValue : DblDyneVec; + title : string; + plottype : integer; + setstring : string[11]; + +begin + SetLength(XValue,Nf1cells); + plottype := 2; + setstring := 'Group'; + GraphFrm.SetLabels[1] := setstring; + maxmean := -10000.0; + minmean := 10000.0; + SetLength(GraphFrm.Xpoints,1,NF1cells); + SetLength(GraphFrm.Ypoints,1,NF1cells); + for i := 1 to NF1cells do + begin + GraphFrm.Ypoints[0,i-1] := RowSums[i-1]; + if RowSums[i-1] > maxmean then maxmean := RowSums[i-1]; + if RowSums[i-1] < minmean then minmean := RowSums[i-1]; + XValue[i-1] := i; + GraphFrm.Xpoints[0,i-1] := XValue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NF1cells; + GraphFrm.Heading := Heading; + title := graphtitle; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Y Values'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := minmean; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +procedure TMedianPolishForm.InteractPlot(NF1cells, NF2Cells : integer; + ObsTable :DblDyneMat; graphtitle : string; + Heading : string); +VAR + i, j : integer; + minmean, maxmean, XBar : double; + XValue: DblDyneVec; + title : string; + plottype : integer; + setstring : string[11]; + +begin + SetLength(GraphFrm.Ypoints,NF1cells,NF2cells); + SetLength(GraphFrm.Xpoints,1,NF2cells); + SetLength(XValue,Nf1cells+Nf2cells); + plottype := 2; + maxmean := -1e308; + minmean := 1e308; + for i := 1 to NF1cells do + begin + setstring := 'Row ' + IntToStr(i); + GraphFrm.SetLabels[i] := setstring; + for j := 1 to NF2cells do + begin + XBar := ObsTable[i-1,j-1]; + if XBar > maxmean then maxmean := XBar; + if XBar < minmean then minmean := XBar; + GraphFrm.Ypoints[i-1,j-1] := XBar; + end; + end; + for j := 1 to NF2cells do + begin + XValue[j-1] := j; + GraphFrm.Xpoints[0,j-1] := XValue[j-1]; + end; + + GraphFrm.nosets := NF1cells; + GraphFrm.nbars := NF2cells; + GraphFrm.Heading := 'Factor X x Factor Y'; + title := 'Column Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := minmean; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + XValue := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +initialization + {$I medianpolishunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multivariate/pathunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/pathunit.lfm new file mode 100644 index 000000000..0a7d09c6c --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/pathunit.lfm @@ -0,0 +1,497 @@ +object PathFrm: TPathFrm + Left = 413 + Height = 387 + Top = 192 + Width = 591 + AutoSize = True + Caption = 'Path Analysis' + ClientHeight = 387 + ClientWidth = 591 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 72 + Top = 266 + Width = 424 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 32 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 2 + ClientHeight = 52 + ClientWidth = 420 + TabOrder = 1 + object StatsChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 181 + Caption = 'Descriptive Statistics' + TabOrder = 0 + end + object ModelChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 181 + Caption = 'Each Model Correlation Matrix' + TabOrder = 2 + end + object Reprochk: TCheckBox + Left = 225 + Height = 19 + Top = 6 + Width = 183 + Caption = 'Reproduced Correlation Matrix' + TabOrder = 1 + end + object SaveChk: TCheckBox + Left = 225 + Height = 19 + Top = 27 + Width = 183 + Caption = 'Save Correlation Matrix' + TabOrder = 3 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 290 + Height = 25 + Top = 354 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 356 + Height = 25 + Top = 354 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 4 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 430 + Height = 25 + Top = 354 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 518 + Height = 25 + Top = 354 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 6 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 338 + Width = 591 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel2: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + Left = 0 + Height = 266 + Top = 0 + Width = 591 + Anchors = [akTop, akLeft, akRight, akBottom] + BevelOuter = bvNone + ClientHeight = 266 + ClientWidth = 591 + TabOrder = 0 + object Panel1: TPanel + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = CausedInBtn + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 248 + Top = 10 + Width = 405 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 10 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 248 + ClientWidth = 405 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 8 + Height = 15 + Top = 0 + Width = 97 + BorderSpacing.Left = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = VarList + AnchorSideTop.Control = Panel1 + Left = 224 + Height = 15 + Top = 0 + Width = 93 + Caption = 'Selected Variables' + ParentColor = False + end + object ListBox1: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 231 + Top = 17 + Width = 172 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 188 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 188 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object VarList: TListBox + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 224 + Height = 231 + Top = 17 + Width = 181 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + MultiSelect = True + TabOrder = 3 + end + end + object Label3: TLabel + AnchorSideTop.Control = Owner + AnchorSideRight.Control = ModelNo + Left = 446 + Height = 15 + Top = 8 + Width = 84 + Anchors = [akTop, akRight] + BorderSpacing.Top = 10 + BorderSpacing.Right = 8 + Caption = 'Model Number:' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = CausedEdit + AnchorSideTop.Control = ScrollBar + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = CausedEdit + Left = 457 + Height = 15 + Top = 69 + Width = 93 + BorderSpacing.Top = 16 + BorderSpacing.Bottom = 2 + Caption = '"Caused" Variable' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = CausingList + AnchorSideTop.Control = CausedEdit + AnchorSideTop.Side = asrBottom + Left = 457 + Height = 15 + Top = 149 + Width = 102 + BorderSpacing.Top = 40 + Caption = '"Causing" Variables' + ParentColor = False + end + object ModelNo: TEdit + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 538 + Height = 23 + Top = 4 + Width = 45 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + TabOrder = 1 + Text = 'ModelNo' + end + object ScrollBar: TScrollBar + AnchorSideLeft.Control = CausedEdit + AnchorSideTop.Control = ModelNo + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 457 + Height = 22 + Top = 31 + Width = 126 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + PageSize = 0 + TabOrder = 2 + OnChange = ScrollBarChange + end + object CausedEdit: TEdit + AnchorSideLeft.Control = CausedInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 457 + Height = 23 + Top = 86 + Width = 126 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 5 + Text = 'CausedEdit' + end + object CausingList: TListBox + AnchorSideLeft.Control = CausingInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label5 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 457 + Height = 92 + Top = 166 + Width = 126 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + TabOrder = 8 + end + object CausedInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = CausedOutBtn + Left = 421 + Height = 28 + Top = 58 + Width = 28 + Anchors = [akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 2 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = CausedInBtnClick + Spacing = 0 + TabOrder = 3 + end + object CausedOutBtn: TBitBtn + AnchorSideLeft.Control = CausedInBtn + AnchorSideTop.Control = CausedEdit + AnchorSideBottom.Side = asrBottom + Left = 421 + Height = 28 + Top = 88 + Width = 28 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 3 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = CausedOutBtnClick + Spacing = 0 + TabOrder = 4 + end + object CausingInBtn: TBitBtn + AnchorSideLeft.Control = CausedInBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = CausingList + Left = 421 + Height = 28 + Top = 166 + Width = 28 + BorderSpacing.Left = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = CausingInBtnClick + Spacing = 0 + TabOrder = 6 + end + object CausingOutBtn: TBitBtn + AnchorSideLeft.Control = CausingInBtn + AnchorSideTop.Control = CausingInBtn + AnchorSideTop.Side = asrBottom + Left = 421 + Height = 28 + Top = 198 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = CausingOutBtnClick + Spacing = 0 + TabOrder = 7 + end + end + object Panel3: TPanel + AnchorSideLeft.Control = GroupBox1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox1 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 432 + Height = 72 + Top = 266 + Width = 159 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BevelOuter = bvNone + ClientHeight = 72 + ClientWidth = 159 + TabOrder = 2 + object ResetModelBtn: TButton + AnchorSideTop.Control = Panel3 + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 17 + Height = 25 + Top = 6 + Width = 134 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 6 + BorderSpacing.Right = 8 + Caption = 'Reset Current Model' + OnClick = ResetModelBtnClick + TabOrder = 0 + end + end + object SaveDialog1: TSaveDialog + left = 72 + top = 104 + end +end diff --git a/applications/lazstats/source/forms/analysis/multivariate/pathunit.pas b/applications/lazstats/source/forms/analysis/multivariate/pathunit.pas new file mode 100644 index 000000000..b72f34e1b --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/pathunit.pas @@ -0,0 +1,812 @@ +unit PathUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, Globals, MatrixLib, DataProcs; + +type + + { TPathFrm } + + TPathFrm = class(TForm) + Bevel1: TBevel; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + SaveDialog1: TSaveDialog; + StatsChk: TCheckBox; + ModelChk: TCheckBox; + Reprochk: TCheckBox; + SaveChk: TCheckBox; + GroupBox1: TGroupBox; + ResetModelBtn: TButton; + CausedInBtn: TBitBtn; + CausedOutBtn: TBitBtn; + CausingInBtn: TBitBtn; + CausingOutBtn: TBitBtn; + CausedEdit: TEdit; + Label4: TLabel; + Label5: TLabel; + CausingList: TListBox; + ModelNo: TEdit; + InBtn: TBitBtn; + Label3: TLabel; + OutBtn: TBitBtn; + Label1: TLabel; + Label2: TLabel; + VarList: TListBox; + ScrollBar: TScrollBar; + ListBox1: TListBox; + procedure CancelBtnClick(Sender: TObject); + procedure CausedInBtnClick(Sender: TObject); + procedure CausedOutBtnClick(Sender: TObject); + procedure CausingInBtnClick(Sender: TObject); + procedure CausingOutBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure ResetModelBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure ScrollBarChange(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + Model : integer; + ModelDefined : BoolDyneVec; + causedseq : IntDyneVec; + nocausing : IntDyneVec; + causingseq : IntDyneMat; + NoModels : integer; + public + { public declarations } + end; + +var + PathFrm: TPathFrm; + +implementation + +uses + Math; + +{ TPathFrm } + +procedure TPathFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + if causingseq = nil then SetLength(causingseq,NoVariables,NoVariables); + if ModelDefined = nil then SetLength(ModelDefined,NoVariables); + if nocausing = nil then SetLength(nocausing,NoVariables); + if causedseq = nil then SetLength(causedseq,NoVariables); + ListBox1.Clear; + CausingList.Clear; + VarList.Clear; + OutBtn.Enabled := false; + InBtn.Enabled := true; + CausedOutBtn.Enabled := false; + CausedInBtn.Enabled := true; + CausingInBtn.Enabled := true; + CausingOutBtn.Enabled := false; + ModelNo.Text := '1'; + ScrollBar.Position := 1; + CausedEdit.Text := ''; + StatsChk.Checked := true; + ModelChk.Checked := true; + ReproChk.Checked := true; + SaveChk.Checked := false; + NoModels := 0; + for i := 1 to NoVariables do + ListBox1.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + for i := 1 to NoVariables do ModelDefined[i-1] := false; +end; + +procedure TPathFrm.ResetModelBtnClick(Sender: TObject); +VAR i : integer; +begin + Model := ScrollBar.Position; + if CausedEdit.Text <> '' then CausedOutBtnClick(self); + if CausingList.Items.Count > 0 then CausingList.Clear; + causedseq[Model-1] := 0; + nocausing[Model-1] := 0; + for i := 1 to nocausing[Model-1] do causingseq[Model-1,i-1] := 0; + ModelDefined[Model-1] := false; +end; + +procedure TPathFrm.ReturnBtnClick(Sender: TObject); +begin + causedseq := nil; + nocausing := nil; + causingseq := nil; + ModelDefined := nil; + Close; +end; + +procedure TPathFrm.ScrollBarChange(Sender: TObject); +var + i, j, col : integer; + cellstring : string; +begin + ScrollBar.Max := NoVariables + 1; + if ScrollBar.Position > NoVariables then + begin + ScrollBar.Position := NoVariables; + exit; + end; + if ScrollBar.Position > NoModels then + begin + if (CausedEdit.Text <> '') and (CausingList.Items.Count > 0) then + begin // save model information + Model := ScrollBar.Position - 1; + ModelDefined[Model-1] := true; + nocausing[Model-1] := CausingList.Items.Count; + NoModels := NoModels + 1; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = CausedEdit.Text then causedseq[Model-1] := i; + for j := 0 to CausingList.Items.Count - 1 do + begin + if cellstring = CausingList.Items.Strings[j] then + causingseq[Model-1,j] := i; + end; + end; + CausingList.Clear; + CausedEdit.Text := ''; + CausedInBtn.Enabled := true; + CausedOutBtn.Enabled := false; + CausingInBtn.Enabled := true; + CausingOutBtn.Enabled := false; + end; + end; + + if ScrollBar.Position <> Model then + begin + CausingList.Clear; + ModelNo.Text := IntToStr(ScrollBar.Position); + Model := ScrollBar.Position; + CausedEdit.Text := ''; + if ModelDefined[Model-1] then // model exists - reload data + begin + col := causedseq[Model-1]; + if col <> 0 then + begin + CausedEdit.Text := OS3MainFrm.DataGrid.Cells[col,0]; + CausingList.Clear; + end + else + begin + CausedEdit.Text := ''; + CausingList.Clear; + exit; + end; + for i := 1 to nocausing[Model-1] do + begin + col := causingseq[Model-1,i-1]; + cellstring := OS3MainFrm.DataGrid.Cells[col,0]; + CausingList.Items.Add(cellstring); + end; + end; + end; +end; + +procedure TPathFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TPathFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TPathFrm.FormShow(Sender: TObject); +begin + causedseq := nil; + nocausing := nil; + causingseq := nil; + ModelDefined := nil; + ResetBtnClick(self); +end; + +procedure TPathFrm.InBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := ListBox1.Items.Count; + i := 0; + while i < index do + begin + if (ListBox1.Selected[i]) then + begin + VarList.Items.Add(ListBox1.Items.Strings[i]); + ListBox1.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + OutBtn.Enabled := true; +end; + +procedure TPathFrm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + if index < 0 then + begin + OutBtn.Enabled := false; + exit; + end; + VarList.Items.Delete(index); +end; + +procedure TPathFrm.CancelBtnClick(Sender: TObject); +begin + causedseq := nil; + nocausing := nil; + causingseq := nil; + ModelDefined := nil; + Close; +end; + +procedure TPathFrm.CausedInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + CausedEdit.Text := VarList.Items.Strings[index]; + CausedOutBtn.Enabled := true; + CausedInBtn.Enabled := false; +end; + +procedure TPathFrm.CausedOutBtnClick(Sender: TObject); +begin + CausedEdit.Text := ''; + CausedOutBtn.Enabled := false; + CausedInBtn.Enabled := true; +end; + +procedure TPathFrm.CausingInBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + for i := 0 to index-1 do + begin + if (VarList.Selected[i]) then + CausingList.Items.Add(VarList.Items.Strings[i]); + end; + CausingOutBtn.Enabled := true; +end; + +procedure TPathFrm.CausingOutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := CausingList.ItemIndex; + if index < 0 then + begin + CausingOutBtn.Enabled := false; + exit; + end; + CausingList.Items.Delete(index); +end; + +procedure TPathFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, col, row, NoVars, nocaused, NoSelected, NoIndepVars : integer; + count, IER, noexogenous, t, L: integer; + constant, StdErrEst, ProbOut, R2, Temp, d2, sum, absdiff : double; + cellstring, outline : string; + ColNoSelected, selected : IntDyneVec; + IndepIndex : IntDyneVec; + rmat, WorkMat, PathCoef, IndMatrix, InvMatrix, e, W : DblDyneMat; + means, variances, stddevs, beta, p : DblDyneVec; + zvals : DblDyneMat; // z scores for path model + genedz : IntDyneVec; // list of z's created for path models + causal : IntDyneMat; + exogenous : IntDyneVec; + RowLabels, ColLabels, Labels: StrDyneVec; + title : string; + matched : boolean; + prtopt : boolean; + errorcode : boolean = false; + done : boolean; + zscore : double; +begin + if NoModels < ScrollBar.Position then + begin + Model := ScrollBar.Position; + ModelDefined[Model-1] := true; + nocausing[Model-1] := CausingList.Items.Count; + NoModels := NoModels + 1; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = CausedEdit.Text then causedseq[Model-1] := i; + for j := 0 to CausingList.Items.Count - 1 do + begin + if cellstring = CausingList.Items.Strings[j] then + causingseq[Model-1,j] := i; + end; + end; + CausingList.Clear; + CausedEdit.Text := ''; + CausedInBtn.Enabled := true; + CausedOutBtn.Enabled := false; + CausingInBtn.Enabled := true; + CausingOutBtn.Enabled := false; + end; + + nocaused := NoModels; + SetLength(rmat,NoVariables+1,NoVariables+1); + SetLength(WorkMat,NoVariables+1,NoVariables+1); + SetLength(PathCoef,NoVariables,NoVariables); + SetLength(IndMatrix,NoVariables,NoVariables); + SetLength(InvMatrix,NoVariables,NoVariables); + SetLength(e,NoVariables,NoVariables); + SetLength(W,NoVariables,NoVariables); + SetLength(means,NoVariables); + SetLength(variances,NoVariables); + SetLength(stddevs,NoVariables); + SetLength(beta,NoVariables); + SetLength(p,NoVariables*NoVariables); + SetLength(Causal,2,NoVariables*NoVariables); + SetLength(RowLabels,NoCases); + SetLength(ColLabels,NoVariables); + SetLength(Labels,NoVariables); + SetLength(IndepIndex,NoVariables); + SetLength(exogenous,NoVariables); + SetLength(ColNoSelected,NoVariables); + SetLength(selected,NoVariables); + SetLength(zvals,NoCases,NoVariables); + SetLength(genedz,NoVariables); + + // get and show model parameters + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('PATH ANALYSIS RESULTS'); + OutputFrm.RichEdit.Lines.Add(''); + + for i := 1 to nocaused do + begin + col := causedseq[i-1]; + outline := 'CAUSED VARIABLE: '; + outline := outline + OS3MainFrm.DataGrid.Cells[col,0]; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(' Causing Variables:'); + for j := 1 to nocausing[i-1] do + begin + col := causingseq[i-1,j-1]; + outline := ' '; + outline := outline + OS3MainFrm.DataGrid.Cells[col,0]; + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // get correlations among all variables selected for the analysis + NoSelected := VarList.Items.Count; + for j := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[j,0]; + for i := 1 to NoSelected do + begin + if cellstring = VarList.Items.Strings[i-1] then + begin + ColNoSelected[i-1] := j; + RowLabels[i-1] := cellstring; + end; + end; + end; + count := NoCases; + Correlations(NoSelected,ColNoSelected,rmat,means,variances,stddevs, errorcode,count); + if SaveChk.Checked then + begin + SaveDialog1.Filter := 'Matrix files (*.MAT)|*.MAT|All files (*.*)|*.*'; + SaveDialog1.FilterIndex := 1; + SaveDialog1.Execute; + MATSAVE(rmat,NoSelected,NoSelected,means,stddevs,count,RowLabels, + RowLabels,SaveDialog1.FileName); + end; + + if StatsChk.Checked then + begin + title := 'Correlation Matrix'; + MAT_PRINT(rmat,NoSelected,NoSelected,title,RowLabels,RowLabels,count); + title := 'MEANS'; + DynVectorPrint(means,NoSelected,title,RowLabels,count); + title := 'VARIANCES'; + DynVectorPrint(variances,NoSelected,title,RowLabels,count); + title := 'STANDARD DEVIATIONS'; + DynVectorPrint(stddevs,NoSelected,title,RowLabels,count); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + // initialize reconstruction matrix, weights matrix and path coefficients + for i := 0 to NoSelected-1 do + begin + for j := 0 to NoSelected-1 do + begin + e[i,j] := 0.0; + W[i,j] := 0.0; + PathCoef[i,j] := 0.0; + end; + end; + + //Now, do the regression analysis for each model + for i := 1 to nocaused do + begin + NoVars := nocausing[i-1] + 1; + for j := 1 to nocausing[i-1] do + begin + col := causingseq[i-1,j-1]; + IndepIndex[j-1] := j; // independents + selected[j-1] := col; + Labels[j-1] := OS3MainFrm.DataGrid.Cells[col,0]; + end; + row := causedseq[i-1]; //sequence no. of caused variable + IndepIndex[NoVars-1] := row; // dependent + selected[NoVars-1] := row; + Labels[NoVars-1] := OS3MainFrm.DataGrid.Cells[row,0]; + + // get correlation matrix for this model + Correlations(NoVars,selected,WorkMat,means,variances,stddevs, + errorcode,count); + if ModelChk.Checked then + begin + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Dependent Variable = %s',[OS3MainFrm.DataGrid.Cells[row,0]]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + title := 'Correlation Matrix'; + MAT_PRINT(WorkMat,NoVars,NoVars,title,Labels,Labels,count); + title := 'MEANS'; + DynVectorPrint(means,NoVars,title,Labels,count); + title := 'VARIANCES'; + DynVectorPrint(variances,NoVars,title,Labels,count); + title := 'STANDARD DEVIATIONS'; + DynVectorPrint(stddevs,NoVars,title,Labels,count); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + // Get regression analysis for this model + ProbOut := 0.999; + NoIndepVars := NoVars - 1; + if StatsChk.Checked then + begin + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Dependent Variable = %s',[OS3MainFrm.DataGrid.Cells[row,0]]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + end; + if StatsChk.Checked then prtopt := true else prtopt := false; + MReg2(count,NoVars,NoIndepVars,IndepIndex,WorkMat,IndMatrix, + Labels,R2,beta,means,variances,IER,StdErrEst,constant, + ProbOut,prtopt,false,false, OutputFrm.RichEdit.Lines); + if prtopt then + begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + for j := 1 to nocausing[i-1] do + begin + col := causingseq[i-1,j-1]; + PathCoef[row-1,col-1] := beta[j-1]; + end; + end; // next i (caused regressions) + + //Now, reconstruct the correlation matrix from path coefficients + //First, obtain list of exogenous variables + noexogenous := 0; + for i := 1 to NoSelected do + begin + matched := false; + col := ColNoSelected[i-1]; + for j := 1 to nocaused do + if (causedseq[j-1] = col) then matched := true; + if ( not matched) then + begin + exogenous[noexogenous] := col; + noexogenous := noexogenous + 1; + end; + end; + + // transform raw scores to z scores for exogenous variables + Correlations(NoSelected,ColNoSelected,rmat,means,variances,stddevs, + errorcode,count); + for i := 1 to noselected do genedz[i-1] := 0; // initialize + for k := 1 to noexogenous do + begin + col := exogenous[k-1]; + for j := 1 to noselected do + begin // find position of corresponding mean and std.dev. + if ColNoSelected[j-1] = col then row := j; + end; + for i := 1 to NoCases do + begin + zvals[i-1,col-1] := StrToFloat(OS3MainFrm.DataGrid.Cells[col,i]); + zvals[i-1,col-1] := (zvals[i-1,col-1] - means[row-1]) / stddevs[row-1]; + RowLabels[i-1] := format('Subject %d',[i]); + end; + genedz[col-1] := 1; // mark as generated + end; +{ + // print matrix of path z scores for exogenous variables + title := 'Data Array of Subject exogenous z Scores'; + MAT_PRINT(zvals,NoCases,NoSelected,title,RowLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; +} + + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + for j := 1 to NoSelected do + begin + if cellstring = VarList.Items.Strings[j-1] then + begin + RowLabels[i-1] := cellstring; + ColLabels[i-1] := cellstring; + end; + end; + end; + + //Build matrix of path coefficients + for i := 1 to nocaused do + begin + row := causedseq[i-1]; + for j := 1 to nocausing[i-1] do + begin + col := causingseq[i-1,j-1]; + W[row-1,col-1] := PathCoef[row-1,col-1]; + end; + end; + + //Print results + if StatsChk.Checked then + begin + title := 'Matrix of Path Coefficients in Rows'; + MAT_PRINT(W,NoSelected,NoSelected,title,ColLabels,ColLabels,count); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; + + //Build models vectors + k := 0; + for i := 1 to nocaused do + begin + for j := 1 to nocausing[i-1] do + begin + k := k + 1; + causal[0,k-1] := causedseq[i-1]; + causal[1,k-1] := causingseq[i-1,j-1]; + row := causedseq[i-1]; + col := causingseq[i-1,j-1]; + p[k-1] := PathCoef[row-1,col-1]; + end; + end; + NoModels := k; + + //Sort on resultant then causing variables + for i := 1 to NoModels - 1 do + begin + for j := i + 1 to NoModels do + begin + if (causal[0,i-1] > causal[0,j-1]) then // swap + begin + t := causal[0,i-1]; + causal[0,i-1] := causal[0,j-1]; + causal[0,j-1] := t; + t := causal[1,i-1]; + causal[1,i-1] := causal[1,j-1]; + causal[1,j-1] := t; + Temp := p[i-1]; + p[i-1] := p[j-1]; + p[j-1] := Temp; + end; + end; + end; + for i := 1 to NoModels - 1 do + begin + for j := i + 1 to NoModels do + begin + if ((causal[0,i-1] = causal[0,j-1]) and (causal[1,i-1] > causal[1,j-1])) then + begin + t := causal[0,i-1]; + causal[0,i-1] := causal[0,j-1]; + causal[0,j-1] := t; + t := causal[1,i-1]; + causal[1,i-1] := causal[1,j-1]; + causal[1,j-1] := t; + Temp := p[i-1]; + p[i-1] := p[j-1]; + p[j-1] := Temp; + end; + end; + end; + + OutputFrm.RichEdit.Lines.Add('SUMMARY OF CAUSAL MODELS'); + OutputFrm.RichEdit.Lines.Add('Var. Caused Causing Var. Path Coefficient'); + + for i := 1 to NoModels do + begin + outline := format('%12s %12s %6.3f', + [OS3MainFrm.DataGrid.Cells[causal[0,i-1],0], + OS3MainFrm.DataGrid.Cells[causal[1,i-1],0], + p[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + //Get reproduced correlation matrix in e + done := false; + while not done do + begin + for i := 1 to nocaused do // check each caused for use of existing z values + begin + for j := 1 to nocausing[i-1] do + begin + count := 0; + for L := 1 to noselected do + begin + if genedz[L-1] = 1 then count := count + 1; + end; + end; + if count >= nocausing[i-1] then // calculate path z + begin + row := causedseq[i-1]; // generation z column & row of path coef. + for j := 1 to nocausing[i-1] do + begin // sum of Path coefficients times corresponding z's + col := causingseq[i-1,j-1]; // column of path coefficient + for k := 1 to NoCases do + begin + zscore := zvals[k-1,col-1]; // causing z score + zvals[k-1,row-1] := zvals[k-1,row-1] + zscore * PathCoef[row-1,col-1]; + end; + end; + genedz[row-1] := 1; // mark as generated + end; // if count equals no. of causing variables + count := 0; // check for completion of all z's + for j := 1 to noselected do + if genedz[j-1] = 1 then count := count + 1; + if count = noselected then done := true; + end; // next i caused variable + end; // while not done + + // print matrix of path z scores + for i := 1 to NoCases do RowLabels[i-1] := format('Subject %d',[i]); + title := 'Data Array of Subject Path z Scores'; + MAT_PRINT(zvals,NoCases,NoSelected,title,RowLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // now calculate the correlation among the generated z values + for i := 1 to noselected do + begin // initialize arrays + for j := 1 to noselected do + begin + e[i-1,j-1] := 0.0; + end; + means[i-1] := 0.0; + stddevs[i-1] := 0.0; + end; + for k := 1 to NoCases do + begin + for i := 1 to noselected do + begin + for j := 1 to noselected do + begin + e[i-1,j-1] := e[i-1,j-1] + zvals[k-1,i-1] * zvals[k-1,j-1]; + end; + means[i-1] := means[i-1] + zvals[k-1,i-1]; + stddevs[i-1] := stddevs[i-1] + (zvals[k-1,i-1] * zvals[k-1,i-1]); + end; + end; + for i := 1 to noselected do + begin + stddevs[i-1] := stddevs[i-1] - (means[i-1] * means[i-1] / NoCases); + stddevs[i-1] := stddevs[i-1] / (NoCases - 1); + stddevs[i-1] := sqrt(stddevs[i-1]); + for j := 1 to noselected do + begin // covariances + e[i-1,j-1] := e[i-1,j-1] - (means[i-1] * means[j-1] / NoCases); + e[i-1,j-1] := e[i-1,j-1] / (NoCases - 1); + end; + means[i-1] := means[i-1] / NoCases; + end; + for i := 1 to noselected do + begin + for j := 1 to noselected do + begin + e[i-1,j-1] := e[i-1,j-1] / (stddevs[i-1]*stddevs[j-1]); + end; + end; + + if (ReproChk.Checked) then + begin + title := 'Reproduced Correlation Matrix'; + MAT_PRINT(e,NoSelected,NoSelected,title,ColLabels,ColLabels,count); + end; + + //Examine discrepencies + d2 := 0.0; + sum := 0.0; + for i := 1 to NoSelected do + begin + for j := 1 to NoSelected do + begin + absdiff := abs(rmat[i-1,j-1] - e[i-1,j-1]); + sum := sum + absdiff; + if (absdiff > d2) then d2 := absdiff; + end; + end; + + OutputFrm.RichEdit.Lines.Add('Average absolute difference between observed and reproduced'); + outline := format('coefficients := %5.3f',[sum / (NoSelected * NoSelected)]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Maximum difference found := %5.3f',[d2]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + + // clean up heap (delete last allocated first) + genedz := nil; + zvals := nil; + selected := nil; + ColNoSelected := nil; + exogenous := nil; + IndepIndex := nil; + Labels := nil; + ColLabels := nil; + RowLabels := nil; + Causal := nil; + p := nil; + beta := nil; + stddevs := nil; + variances := nil; + means := nil; + W := nil; + e := nil; + InvMatrix := nil; + IndMatrix := nil; + PathCoef := nil; + WorkMat := nil; + rmat := nil; +end; + + +initialization + {$I pathunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multivariate/rotateunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/rotateunit.lfm new file mode 100644 index 000000000..e6cc83dbe --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/rotateunit.lfm @@ -0,0 +1,131 @@ +object RotateFrm: TRotateFrm + Left = 456 + Height = 442 + Top = 158 + Width = 662 + Caption = 'Manual Rotation of Factors' + ClientHeight = 442 + ClientWidth = 662 + OnActivate = FormActivate + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Image1: TImage + Left = 8 + Height = 380 + Top = 8 + Width = 646 + Align = alClient + BorderSpacing.Around = 8 + end + object Panel1: TPanel + Left = 0 + Height = 46 + Top = 396 + Width = 662 + Align = alBottom + ClientHeight = 46 + ClientWidth = 662 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ReturnBtn + AnchorSideTop.Side = asrCenter + Left = 9 + Height = 15 + Top = 14 + Width = 84 + BorderSpacing.Left = 8 + Caption = 'Points Rotation:' + ParentColor = False + end + object DegEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ReturnBtn + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label1 + AnchorSideRight.Side = asrBottom + Left = 101 + Height = 23 + Top = 10 + Width = 64 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Right = 16 + TabOrder = 0 + Text = 'DegEdit' + end + object ScrollBar1: TScrollBar + AnchorSideLeft.Control = DegEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ReturnBtn + AnchorSideTop.Side = asrCenter + Left = 181 + Height = 21 + Top = 11 + Width = 155 + BorderSpacing.Left = 8 + PageSize = 0 + TabOrder = 1 + OnChange = ScrollBar1Change + end + object NextBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = PrintBtn + Left = 451 + Height = 25 + Top = 9 + Width = 74 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'Next Pair' + OnClick = NextBtnClick + TabOrder = 2 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 1 + Height = 8 + Top = 1 + Width = 660 + Anchors = [akTop, akLeft, akRight] + Shape = bsTopLine + end + object PrintBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 537 + Height = 25 + Top = 9 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'Print' + OnClick = PrintBtnClick + TabOrder = 3 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 600 + Height = 25 + Top = 9 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 4 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/multivariate/rotateunit.pas b/applications/lazstats/source/forms/analysis/multivariate/rotateunit.pas new file mode 100644 index 000000000..3e5308543 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/rotateunit.pas @@ -0,0 +1,268 @@ +unit RotateUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, Printers, + Globals; + +type + + { TRotateFrm } + + TRotateFrm = class(TForm) + Bevel1: TBevel; + Image1: TImage; + NextBtn: TButton; + PrintBtn: TButton; + ReturnBtn: TButton; + DegEdit: TEdit; + Label1: TLabel; + Panel1: TPanel; + ScrollBar1: TScrollBar; + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure NextBtnClick(Sender: TObject); + procedure PrintBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure ScrollBar1Change(Sender: TObject); + private + { private declarations } + Axis1, Axis2 : integer; + ClWidth, ClHeight, XStart, XEnd, YStart, YEnd : integer; + Xoffset, Yoffset, XaxisLength, YaxisLength : integer; + Axis1Pos, Axis2Pos : integer; + q : DblDyneMat; + procedure PlotPts(AxisOne, AxisTwo : integer; acolor : TColor; Sender : TObject); + procedure DrawAxis(Sender : TObject); + + public + { public declarations } + Loadings : DblDyneMat; + NoVars : integer; + NoRoots : integer; + RowLabels : StrDyneVec; + ColLabels : StrDyneVec; + Order : IntDyneVec; + end; + +var + RotateFrm: TRotateFrm; + +implementation + +uses + Math; + +{ TRotateFrm } + +procedure TRotateFrm.ReturnBtnClick(Sender: TObject); +VAR i, j : integer; +begin + for i := 1 to NoVars do + BEGIN + for j := 1 to NoRoots do Loadings[i-1,j-1] := q[i-1,j-1]; + END; + q := nil; + Close; +end; + +procedure TRotateFrm.ScrollBar1Change(Sender: TObject); +var + D, A, B : double; + i, j, l : integer; + AxisOne, AxisTwo : integer; +begin + AxisOne := Axis1; + AxisTwo := Axis2; + PlotPts(AxisOne,AxisTwo,clWhite,self); // erase previous + DrawAxis(self); + for i := 1 to NoVars do + begin + for j := 1 to NoRoots do q[i-1,j-1] := Loadings[i-1,j-1]; + end; + + D := ScrollBar1.Position; + DegEdit.Text := FloatToStr(D); + D := D / 57.2958; // convert to radians + for l := 1 to NoVars do + BEGIN + A := sin(D); + B := cos(D); + q[l-1,AxisOne-1] := Loadings[l-1,AxisOne-1] * B - Loadings[l-1,AxisTwo-1] * A; + q[l-1,AxisTwo-1] := Loadings[l-1,AxisOne-1] * A + Loadings[l-1,AxisTwo-1] * B; + END; + + PlotPts(AxisOne,AxisTwo,clBlack,self); // plot new +end; + +procedure TRotateFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([NextBtn.Width, PrintBtn.Width, ReturnBtn.Width]); + NextBtn.Constraints.MinWidth := w; + PrintBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure TRotateFrm.FormShow(Sender: TObject); +VAR i, j : integer; +begin + if NoRoots < 2 then + begin + ShowMessage('ERROR! Only 1 factor-exiting'); + exit; + end; + SetLength(q,NoVars,NoVars); + for i := 1 to NoVars do + begin + for j := 1 to NoRoots do q[i-1,j-1] := Loadings[i-1,j-1]; + end; + ClWidth := Image1.Width; + ClHeight := Image1.Height; + XOffset := ClWidth div 10; + YOffset := ClHeight div 10; + XStart := Xoffset; + XEnd := ClWidth - XOffset; + XAxisLength := XEnd - XStart; + YStart := ClHeight - YOffset; + YEnd := YOffset; + YAxisLength := YStart - YEnd; + Image1.Canvas.Brush.Color := clWhite; + Image1.Canvas.Pen.Color := clBlack; + Image1.Canvas.Rectangle(0,0,ClWidth,ClHeight); + Axis1 := 1; + Axis2 := 2; + Axis2Pos := XAxisLength div 2 + XStart; // position of y axis from left + Axis1Pos := YAxisLength div 2 + YEnd; // position of X axis from top + ScrollBar1.Position := 0; + DrawAxis(self); + PlotPts(Axis1, Axis2, clBlack, self); +end; + +procedure TRotateFrm.NextBtnClick(Sender: TObject); +VAR i, j : integer; +begin + if (Axis2 = NoRoots) and (Axis1 = NoRoots-1) then + begin + ShowMessage('ALL DONE! All pairs completed.'); + exit; + end; + PlotPts(Axis1,Axis2,clWhite,self); + for i := 1 to NoVars do + BEGIN + for j := 1 to NoRoots do Loadings[i-1,j-1] := q[i-1,j-1]; + END; + + Axis2 := Axis2 + 1; + if Axis2 <= NoRoots then + begin + ScrollBar1.Position := 0; + DrawAxis(self); + PlotPts(Axis1,Axis2,clBlack,self); + exit; + end; + Axis1 := Axis1 + 1; + Axis2 := Axis1 + 1; + if Axis2 > NoRoots then exit; + ScrollBar1.Position := 0; + DrawAxis(self); + PlotPts(Axis1,Axis2,clBlack,self); +end; + +procedure TRotateFrm.PrintBtnClick(Sender: TObject); +var r : Trect; +begin + with Printer do + begin + Printer.Orientation := poPortrait; + r := Rect(20,20,printer.pagewidth-20,printer.pageheight div 2 + 20); + BeginDoc; + Canvas.StretchDraw(r,Image1.Picture.BitMap); + EndDoc; + end; +end; + +procedure TRotateFrm.PlotPts(AxisOne, AxisTwo: integer; acolor: TColor; + Sender: TObject); +var i, xpos, ypos, xmid, ymid, size : integer; +begin + xmid := Axis2Pos; + ymid := Axis1Pos; + Image1.Canvas.Pen.Color := acolor; +// if color <> clWhite then size := 2 else size := 4; + size := 4; + for i := 1 to NoVars do + begin + if q[i-1,AxisOne-1] >= 0 then // positive x value + begin + xpos := round(q[i-1,AxisOne-1] * (XAxisLength div 2)); + xpos := xpos + xmid; + end + else // negative x value (factor 1) + begin + xpos := round(abs(q[i-1,AxisOne-1]) * (XAxisLength div 2)); + xpos := xmid - xpos; + end; + if q[i-1,AxisTwo-1] >= 0 then // positive y value (factor 2) + begin + ypos := round(q[i-1,AxisTwo-1] * (YAxisLength div 2)); + ypos := ymid - ypos; + end + else // negative y factor loading + begin + ypos := round(abs(q[i-1,AxisTwo-1]) * (YAxisLength div 2)); + ypos := ymid + ypos; + end; + + Image1.Canvas.Ellipse(xpos-size,ypos-size,xpos+size,Ypos+size); + end; + DrawAxis(self); +end; + +procedure TRotateFrm.DrawAxis(Sender: TObject); +var + i, xincr, yincr, TextLong : integer; + step : double; + Title : string; +begin + xincr := XAxisLength div 10; + yincr := YAxisLength div 10; + + // draw X axis + Image1.Canvas.MoveTo(XOffset,Axis1Pos); + Image1.Canvas.LineTo(XEnd,Axis1Pos); + Title := 'Factor ' + IntToStr(Axis1); + Image1.Canvas.TextOut(0,Axis1Pos,Title); + step := -1.0; + for i := 0 to 10 do + begin + Title := format('%4.1f',[step]); + Image1.Canvas.TextOut(XOffset+xincr*i,Axis1Pos+2,Title); + step := step + 0.2; + end; + // draw Y axis + Image1.Canvas.MoveTo(Axis2Pos,YEnd); + Image1.Canvas.LineTo(Axis2Pos,YStart); + Title := 'Factor ' + IntToStr(Axis2); + Image1.Canvas.TextOut(Axis2Pos,0,Title); + step := -1.0; + for i := 0 to 10 do + begin + Title := format('%4.1f',[step]); + TextLong := Image1.Canvas.TextWidth(Title); + Image1.Canvas.TextOut(Axis2Pos-TextLong,YStart-(i*yincr),Title); + step := step + 0.2; + end; +end; + + +initialization + {$I rotateunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.lfm new file mode 100644 index 000000000..32c91c3d2 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.lfm @@ -0,0 +1,341 @@ +object SingleLinkFrm: TSingleLinkFrm + Left = 579 + Height = 284 + Top = 362 + Width = 409 + AutoSize = True + Caption = 'Single Linkage Cluster Analysis' + ClientHeight = 284 + ClientWidth = 409 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 108 + Height = 25 + Top = 251 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 174 + Height = 25 + Top = 251 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 248 + Height = 25 + Top = 251 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 3 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 336 + Height = 25 + Top = 251 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 4 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 235 + Width = 409 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 219 + Top = 8 + Width = 393 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 219 + ClientWidth = 393 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Available Variables' + ParentColor = False + end + object ListBox1: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = VarInBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 202 + Top = 17 + Width = 174 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 0 + end + object Label2: TLabel + AnchorSideLeft.Control = VarSelEdit + AnchorSideRight.Control = VarSelEdit + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = VarSelEdit + Left = 218 + Height = 15 + Top = 31 + Width = 175 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Variable Selected for Analysis' + ParentColor = False + WordWrap = True + end + object VarInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ListBox1 + Left = 182 + Height = 28 + Top = 17 + Width = 28 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = VarInBtnClick + Spacing = 0 + TabOrder = 1 + end + object VarOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarInBtn + AnchorSideTop.Side = asrBottom + Left = 182 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = VarOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object VarSelEdit: TEdit + AnchorSideLeft.Control = VarInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = VarOutBtn + AnchorSideBottom.Side = asrBottom + Left = 218 + Height = 23 + Top = 48 + Width = 175 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 6 + TabOrder = 3 + Text = 'VarSelEdit' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = VarInBtn + AnchorSideTop.Control = VarOutBtn + AnchorSideTop.Side = asrBottom + Left = 182 + Height = 135 + Top = 93 + Width = 178 + AutoSize = True + BorderSpacing.Top = 16 + Caption = 'Analysis Options:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 115 + ClientWidth = 174 + TabOrder = 4 + object StdChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 150 + Caption = 'Standardize Variable' + TabOrder = 0 + end + object RepChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 150 + Caption = 'Replace Grid Values' + TabOrder = 1 + end + object DescChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 150 + Caption = 'Show Each Combination' + TabOrder = 2 + end + object PlotChkBox: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 150 + Caption = 'Groups Vs Error Plot' + TabOrder = 3 + end + object DendoChk: TCheckBox + Left = 12 + Height = 19 + Top = 90 + Width = 150 + Caption = 'Dendogram Plot' + TabOrder = 4 + end + end + end +end diff --git a/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.pas b/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.pas new file mode 100644 index 000000000..9a401ccb9 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.pas @@ -0,0 +1,673 @@ +unit SingleLinkUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, OutputUnit; + +type + + { TSingleLinkFrm } + + TSingleLinkFrm = class(TForm) + Bevel1: TBevel; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + StdChkBox: TCheckBox; + RepChkBox: TCheckBox; + DescChkBox: TCheckBox; + PlotChkBox: TCheckBox; + DendoChk: TCheckBox; + GroupBox1: TGroupBox; + VarSelEdit: TEdit; + Label2: TLabel; + VarInBtn: TBitBtn; + VarOutBtn: TBitBtn; + Label1: TLabel; + ListBox1: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarInBtnClick(Sender: TObject); + procedure VarOutBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure TreePlot(VAR Clusters : IntDyneMat; + VAR Lst : IntDyneVec; + NoPoints : integer); + procedure scatplot(var x : DblDyneVec; + var y : DblDyneVec; + nocases : integer; + titlestr : string; + x_axis, y_axis : string; + x_min, x_max, y_min, y_max : double; + VAR VarLabels : StrDyneVec); + + public + { public declarations } + end; + +var + SingleLinkFrm: TSingleLinkFrm; + +implementation + +uses + Math; + +{ TSingleLinkFrm } + +procedure TSingleLinkFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; + cellstring : string; +begin + ListBox1.Clear; + VarSelEdit.Text := ''; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + ListBox1.Items.Add(cellstring); + end; + RepChkBox.Checked := false; + StdChkBox.Checked := false; + VarOutBtn.Enabled := false; + DescChkBox.Checked := false; + PlotChkBox.Checked := false; +end; + +procedure TSingleLinkFrm.VarInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := ListBox1.ItemIndex; + VarSelEdit.Text := ListBox1.Items.Strings[index]; + VarOutBtn.Enabled := true; +end; + +procedure TSingleLinkFrm.VarOutBtnClick(Sender: TObject); +begin + ListBox1.Items.Add(VarSelEdit.Text); + VarSelEdit.Text := ''; +end; + +procedure TSingleLinkFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TSingleLinkFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TSingleLinkFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TSingleLinkFrm.ComputeBtnClick(Sender: TObject); +VAR + NoInGrp : IntDyneVec; // no. of subjects in a grouping + i, j, NoGroups, ID, ID1, ID2, col, startat, endat : integer; + ColSelected : integer; + NoScores : integer; + varlabel : string; +// outline : array[1..501] of char; +// astring : array[0..5] of char; + outline : string; + astring : string; + Scores : DblDyneVec; // subject scores + Distance : DblDyneMat; // distance between objects + SubjectIDs : IntDyneVec; // subject ids - sorted with Distance + X1: double; // grid values of two subjects + Groups : IntDyneMat; // subjects in each group + GrpErrors : DblDyneVec; + Smallest, Mean, Variance, StdDev : double; + clusters : IntDyneMat; + Lst : IntDyneVec; + done : boolean; + average : double; + XAxis, YAxis : DblDyneVec; + MaxError : double; + GrpLabels : StrDyneVec; + +label labels1, labels2; + +begin + NoScores := NoCases; + Mean := 0.0; + Variance := 0.0; + varlabel := VarSelEdit.Text; + + //Get selected variable + ColSelected := 0; + for j := 1 to NoVariables do + if (VarSelEdit.Text = OS3MainFrm.DataGrid.Cells[j,0]) then ColSelected := j; + if (ColSelected = 0) then + begin + ShowMessage('ERROR! No variable selected to analyze.'); + exit; + end; + + // Allocate memory + SetLength(Distance,NoCases+1,NoCases+1); + SetLength(SubjectIDs,NoCases+1); + SetLength(NoInGrp,NoCases+1); + SetLength(Groups,NoCases+1,NoCases+1); + SetLength(Scores,NoCases+1); + SetLength(GrpErrors,NoCases+1); + SetLength(clusters,NoCases+1,3); + SetLength(Lst,NoCases+1); + + // initialize arrays + for i := 0 to NoCases-1 do + begin + NoInGrp[i] := 1; + SubjectIDs[i] := i+1; + for j := 0 to NoCases-1 do + begin + Groups[i,j] := 0; + Distance[i,j] := 0.0; + end; + for j := 0 to 2 do clusters[i,j] := 0; + end; + NoGroups := 0; + + // Get data into the distance matrix + for i := 0 to NoCases - 1 do + begin + col := ColSelected; + Scores[i] := StrToFloat(OS3MainFrm.DataGrid.Cells[col,i+1]); + Mean := Mean + Scores[i]; + Variance := Variance + (Scores[i] * Scores[i]); + end; + Variance := Variance - ((Mean * Mean) / NoCases); + Variance := Variance / (NoCases - 1); + StdDev := sqrt(Variance); + Mean := Mean / NoCases; + + // sort the scores and ids in distance and subjed ids + for i := 0 to NoCases - 2 do + begin + for j := i+1 to NoCases - 1 do + begin + if (Scores[i] > Scores[j]) then // swap + begin + X1 := Scores[i]; + Scores[i] := Scores[j]; + Scores[j] := X1; + ID := SubjectIDs[i]; + SubjectIDs[i] := SubjectIDs[j]; + SubjectIDs[j] := ID; + end; + end; + end; + for i := 0 to NoCases - 1 do Lst[i+1] := SubjectIDs[i]; + + // Show results + OutputFrm.RichEdit.Lines.Add('Single Linkage Clustering by Bill Miller'); + outline := format('FILE: %s',[OS3MainFrm.FileNameEdit.Text]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Variable := %s',[varlabel]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Number of cases := %d',[NoCases]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Mean := %8.3f, Variance := %8.3f, Std.Dev. := %8.3f',[Mean, Variance, StdDev]); + OutputFrm.RichEdit.Lines.Add(outline); + + // Standardize the distance scores if elected + if (StdChkBox.Checked) then + begin + for i := 0 to NoCases - 1 do Scores[i] := (Scores[i] - Mean) / StdDev; + if (RepChkBox.Checked) then // replace original values in DataGrid with z scores if elected + begin + for i := 0 to NoCases - 1 do + begin + col := ColSelected; + outline := format('%6.4f',[Scores[i]]); + OS3MainFrm.DataGrid.Cells[col,i+1] := outline; + end; + end; + end; + + OutputFrm.RichEdit.Lines.Add(''); + if (DescChkBox.Checked) then + begin + done := false; + startat := 0; + endat := NoScores; + if (endat > 20) then endat := 20; +// ptr := outline; + while (not done) do + begin + outline := 'GROUP ID'; + for i := startat to endat - 1 do + begin + astring := format('%4d',[SubjectIDs[i]]); + outline := outline + astring; +// strcat(@outline,@astring); + end; + OutputFrm.RichEdit.Lines.Add(outline); + startat := endat; + if (startat >= NoScores) then done := true; + endat := startat + 20; + if (endat > NoScores) then endat := NoScores; + end; + end; + + // calculate Distances and smallest Distance +labels1: + Smallest := abs(Scores[0] - Scores[1]); // initial values + for i := 0 to NoScores - 2 do + begin + for j := i+1 to NoScores - 1 do + begin + Distance[i,j] := abs(Scores[i] - Scores[j]); + Distance[j,i] := Distance[i,j]; + if (Distance[i,j] <= Smallest) then + begin + Smallest := Distance[i,j]; + ID1 := i; + ID2 := j; + end; + end; + end; + + if (NoGroups < NoCases-1) then + begin + if (DescChkBox.Checked) then + begin + outline := format(' Group %d is combined with Group %d', + [SubjectIDs[ID1],SubjectIDs[ID2]]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + end; + end; + + // eliminate second score and replace first with average + NoInGrp[ID1] := NoInGrp[ID1] + 1; + NoInGrp[ID2] := NoInGrp[ID2] - 1; + clusters[NoGroups+1,1] := SubjectIDs[ID1]; + clusters[NoGroups+1,2] := SubjectIDs[ID2]; + + // record results for this grouping +labels2: + Groups[NoGroups,ID1] := 1; // set flags for those objects grouped + Groups[NoGroups,ID2] := 1; + + if (NoGroups < NoCases-1) then // eliminate second score and replace first with average + begin + average := abs(Scores[ID1] + Scores[ID2]) / 2.0; + Scores[ID1] := average; + for i := ID2 to NoScores - 2 do + begin + Scores[i] := Scores[i+1]; + SubjectIDs[i] := SubjectIDs[i+1]; + end; + NoScores := NoScores - 1; + for i := 0 to NoScores - 1 do Groups[NoGroups,SubjectIDs[i]] := 1; + if (DescChkBox.Checked) then + begin + done := false; + startat := 0; + endat := NoScores; + if (endat > 20) then endat := 20; + while (not done) do + begin + outline := 'GROUP ID'; + for i := startat to endat - 1 do + begin + astring := format('%4d',[SubjectIDs[i]]); + outline := outline + astring; + end; + OutputFrm.RichEdit.Lines.Add(outline); + startat := endat; + if (startat >= NoScores) then done := true; + endat := startat + 20; + if (endat > NoScores) then endat := NoScores; + end; + end; + + // get errors + GrpErrors[NoGroups] := GrpErrors[NoGroups] + Distance[ID1,ID2]; + NoGroups := NoGroups + 1; + goto labels1; + end; + + // show errors + if (DescChkBox.Checked) then + begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('GROUPING STEP ERROR'); + for i := 0 to NoGroups - 1 do + begin + outline := format(' %3d %10.3f',[i+1,GrpErrors[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + if (PlotChkBox.Checked) then + begin + MaxError := GrpErrors[NoGroups-1]; + SetLength(XAxis,NoCases); + SetLength(YAxis,NoCases); + SetLength(GrpLabels,NoGroups+1); + for i := 0 to NoGroups - 1 do + begin + XAxis[i] := NoGroups - i; + YAxis[i] := GrpErrors[i]; + GrpLabels[i] := IntToStr(i + 1); + end; + scatplot(XAxis, YAxis, NoGroups, 'Plot of Error vs No. of Groups', + 'No. of Groups', 'Size of Error', 2.0, NoCases, 0.0, MaxError,GrpLabels); + GrpLabels := nil; + YAxis := nil; + XAxis := nil; + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + if (DendoChk.Checked) then + begin + OutputFrm.RichEdit.Clear; + TreePlot(clusters,Lst,NoGroups+1); + OutputFrm.ShowModal; + end; + OutputFrm.RichEdit.Clear; + //clean up the memory + Lst := nil; + clusters := nil; + GrpErrors := nil; + Scores := nil; + Groups := nil; + NoInGrp := nil; + SubjectIDs := nil; + Distance := nil; +end; + +procedure TSingleLinkFrm.TreePlot(VAR Clusters : IntDyneMat; + VAR Lst : IntDyneVec; + NoPoints : integer); +VAR + outline : array[0..501] of char; + aline : array[0..82] of char; + valstr : string; + tempstr : string; + plotline : string; + star : char; + blank : char; + col1, col2, colpos1, colpos2 : integer; + noparts, startcol, endcol : integer; + Results : StrDyneVec; + ColPos : IntDyneVec; + i, j, k, L, linecount, newcol, howlong, count: integer; + done : boolean; +begin + linecount := 1; + star := '*'; + blank := ' '; + SetLength(ColPos,NoPoints+2); + SetLength(Results,NoPoints*2+3); + OutputFrm.RichEdit.Lines.Add(''); + done := false; + // store initial column positions of vertical linkages + for i := 1 to NoPoints do ColPos[Lst[i]] := 4 + (i * 5); + + // create column heading indented 10 spaces + tempstr := 'UNIT '; + for i := 1 to NoPoints do + begin + valstr := format('%5d',[Lst[i]]); + tempstr := tempstr + valstr; + end; + Results[linecount] := tempstr; + linecount := linecount + 1; + + // create beginning of vertical linkages + plotline := 'STEP '; + for i := 1 to NoPoints do plotline := plotline + ' *'; + Results[linecount] := plotline; + linecount := linecount + 1; + + // start dendoplot + for i := 1 to NoPoints - 1 do + begin + outline := ''; + valstr := format('%5d',[i]); // put step no. first + outline := valstr; + // clear remainder of outline + for j := 5 to (5 + NoPoints * 5) do outline[j] := ' '; + outline[6 + NoPoints * 5] := #0; + col1 := Clusters[i,1]; + col2 := Clusters[i,2]; + // find column positions for each variable + colpos1 := ColPos[col1]; + colpos2 := ColPos[col2]; + + for k := colpos1 to colpos2 do outline[k] := star; + // change column positions 1/2 way between the matched ones + newcol := colpos1 + ((colpos2 - colpos1) div 2); + for k := 1 to NoPoints do + if ((ColPos[k] = colpos1) or (ColPos[k] = colpos2)) then ColPos[k] := newcol; + for k := 1 to NoPoints do + begin + L := ColPos[k]; + if ((L <> colpos1) and (L <> colpos2)) then outline[L] := star; + end; + Results[linecount] := outline; + linecount := linecount + 1; + + // add a line of connectors to next grouping + outline := ' '; + for j := 5 to (5 + NoPoints * 5) do outline[j] := blank; + for j := 1 to NoPoints do + begin + colpos1 := ColPos[j]; + outline[colpos1] := star; + end; + Results[linecount] := outline; + linecount := linecount + 1; + end; + + // output the Results in parts + // determine number of pages needed for whole plot + noparts := 0; + howlong := Length(Results[1]); + noparts := round(howlong / 80.0); + if (noparts <= 0) then noparts := 1; + + if (noparts = 1) then // simply print the list + begin + for i := 0 to linecount - 1 do + begin + OutputFrm.RichEdit.Lines.Add(Results[i]); + end; + end + else // break lines into strings of 15 units + begin + startcol := 0; + endcol := 80; + for i := 1 to noparts do + begin + outline := format('PART %d OUTPUT',[i]); + OutputFrm.RichEdit.Lines.Add(outline); + for j := 0 to 80 do aline[j] := blank; + + for j := 0 to linecount - 1 do + begin + count := 0; + outline := Results[j]; + for k := startcol to endcol do + begin + aline[count] := outline[k]; + count := count + 1; + end; + aline[count+1] := #0; + OutputFrm.RichEdit.Lines.Add(aline); + end; + OutputFrm.RichEdit.Lines.Add(''); + startcol := endcol + 1; + endcol := endcol + 80; + if (endcol > howlong) then endcol := howlong; + end; + end; + Results := nil; + ColPos := nil; +end; + +procedure TSingleLinkFrm.scatplot(var x : DblDyneVec; + var y : DblDyneVec; + nocases : integer; + titlestr : string; + x_axis, y_axis : string; + x_min, x_max, y_min, y_max : double; + VAR VarLabels : StrDyneVec); + +var + i, j, l, row, xslot : integer; + xdelta, maxy: double; + incrementx, incrementy, rangex, rangey, swap : double; + plotstring : array[0..51,0..61] of char; + ymed, xmed : double; + aheight : integer; + overlap : boolean; + valuestring : string[2]; + howlong : integer; + outline : string; + Labels : StrDyneVec; +begin + SetLength(Labels,nocases); + for i := 1 to nocases do Labels[i-1] := VarLabels[i-1]; + aheight := 40; + rangex := x_max - x_min ; + incrementx := rangex / 15.0; + xdelta := rangex / 60; + xmed := rangex / 2; + rangey := y_max - y_min; + incrementy := rangey / aheight; + ymed := rangey / 2; + + { sort in descending order } + for i := 1 to (nocases - 1) do + begin + for j := (i + 1) to nocases do + begin + if y[i-1] < y[j-1] then + begin + swap := y[i-1]; + y[i-1] := y[j-1]; + y[j-1] := swap; + swap := x[i-1]; + x[i-1] := x[j-1]; + x[j-1] := swap; + outline := Labels[i-1]; + Labels[i-1] := Labels[j-1]; + Labels[j-1] := outline; + end; + end; + end; + outline := ' SCATTERPLOT - ' + titlestr; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add(y_axis); + maxy := y_max; + for i := 1 to 60 do + for j := 1 to aheight+1 do plotstring[j,i] := ' '; + + { Set up the plot strings with the data } + row := 0; + while maxy > y_min do + begin + row := row + 1; + plotstring[row,30] := '|'; + if (row = (aheight / 2)) then + begin + for i := 1 to 60 do plotstring[row,i] := '-'; + end; + for i := 1 to nocases do + begin + if ((maxy >= y[i-1]) and (y[i-1] > (maxy - incrementy))) then + begin + xslot := round(((x[i-1] - x_min) / rangex) * 60); + if xslot < 1 then xslot := 1; + if xslot > 60 then xslot := 60; + overlap := false; + str(i:2,valuestring); + howlong := 1; + if (valuestring[1] <> ' ') then howlong := 2; + for l := xslot to (xslot + howlong - 1) do + if (plotstring[row,l] = '*') then overlap := true; + if (overlap) then plotstring[row,xslot] := '*' + else + begin + if (howlong < 2) then + plotstring[row,xslot] := valuestring[2] + else for l := 1 to 2 do + plotstring[row,xslot + l - 1] := valuestring[l]; + end; + end; + end; + maxy := maxy - incrementy; + end; + { print the plot } + for i := 1 to row do + begin + outline := ' |'; + for j := 1 to 60 do outline := outline + format('%1s',[plotstring[i,j]]); + outline := outline + format('|-%6.2f-%6.2f', + [(y_max - i * incrementy),(y_max - i * incrementy + incrementy)]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := ''; + for i := 1 to 63 do outline := outline + '-'; + OutputFrm.RichEdit.Lines.Add(outline); + outline := ''; + for i := 1 to 16 do outline := outline + ' | '; + outline := outline + x_axis; + OutputFrm.RichEdit.Lines.Add(outline); + outline := ''; + for i := 1 to 16 do outline := outline + format('%4.1f',[(x_min + i * incrementx - incrementx)]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Labels:'); + for i := 1 to nocases do + begin + outline := format('%2d = %s',[i,Labels[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + Labels := nil; +end; { of scatplot procedure } + + +initialization + {$I singlelinkunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/binomialunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/binomialunit.lfm new file mode 100644 index 000000000..e8ad6b255 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/binomialunit.lfm @@ -0,0 +1,194 @@ +object BinomialFrm: TBinomialFrm + Left = 802 + Height = 175 + Top = 338 + Width = 340 + AutoSize = True + BorderStyle = bsSingle + Caption = 'Binomial Probability Calculator' + ClientHeight = 175 + ClientWidth = 340 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + Left = 121 + Height = 25 + Top = 145 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 0 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 183 + Height = 25 + Top = 145 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 1 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 267 + Height = 25 + Top = 145 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 2 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 9 + Top = 128 + Width = 340 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 12 + Height = 120 + Top = 8 + Width = 292 + Alignment = taRightJustify + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BevelOuter = bvNone + ClientHeight = 120 + ClientWidth = 292 + TabOrder = 3 + object Label1: TLabel + AnchorSideTop.Control = FreqAEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = FreqAEdit + Left = 2 + Height = 15 + Top = 12 + Width = 239 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Frequency of events observed in category ''A'':' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = FreqBEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = FreqBEdit + Left = 3 + Height = 15 + Top = 39 + Width = 238 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Frequency of events observed in category ''B'':' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = PropAEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 66 + Width = 241 + Caption = 'Proportion of events expected in category ''A'':' + ParentColor = False + end + object FreqAEdit: TEdit + AnchorSideLeft.Control = PropAEdit + AnchorSideTop.Control = Panel1 + Left = 249 + Height = 23 + Top = 8 + Width = 43 + Alignment = taRightJustify + BorderSpacing.Top = 8 + TabOrder = 0 + Text = 'FreqAEdit' + end + object FreqBEdit: TEdit + AnchorSideLeft.Control = PropAEdit + AnchorSideTop.Control = FreqAEdit + AnchorSideTop.Side = asrBottom + Left = 249 + Height = 23 + Top = 35 + Width = 43 + Alignment = taRightJustify + BorderSpacing.Top = 4 + TabOrder = 1 + Text = 'FreqBEdit' + end + object PropAEdit: TEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = FreqBEdit + AnchorSideTop.Side = asrBottom + Left = 249 + Height = 23 + Top = 62 + Width = 43 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + TabOrder = 2 + Text = 'ProbAEdit' + end + object PlotChk: TCheckBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = PropAEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 167 + Height = 19 + Top = 101 + Width = 125 + Alignment = taLeftJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 16 + Caption = 'Plot the distribution' + TabOrder = 3 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/binomialunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/binomialunit.pas new file mode 100644 index 000000000..43a518403 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/binomialunit.pas @@ -0,0 +1,212 @@ +unit BinomialUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + OutputUnit, FunctionsLib, GraphLib; + +type + + { TBinomialFrm } + + TBinomialFrm = class(TForm) + Bevel1: TBevel; + Panel1: TPanel; + PlotChk: TCheckBox; + ResetBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + FreqAEdit: TEdit; + FreqBEdit: TEdit; + PropAEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + { private declarations } + public + { public declarations } + end; + +var + BinomialFrm: TBinomialFrm; + +implementation + +uses + Math; + +{ TBinomialFrm } + +procedure TBinomialFrm.ResetBtnClick(Sender: TObject); +begin + FreqAEdit.Text := ''; + FreqBEdit.Text := ''; + PropAEdit.Text := ''; + FreqAEdit.SetFocus; +end; + +procedure TBinomialFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure TBinomialFrm.FormCreate(Sender: TObject); +begin + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TBinomialFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TBinomialFrm.ComputeBtnClick(Sender: TObject); +var + p, Q, Probability, z, CorrectedA, SumProb : double; + A, b, N, X, i: integer; + outline : string; + lReport: TStrings; + msg: String; + C: TWinControl; +begin + if not Validate(msg, C) then begin + C.SetFocus; + MessageDlg(msg, mtError,[mbOK], 0); + ModalResult := mrNone; + exit; + end; + + SumProb := 0.0; + A := round(StrToFloat(FreqAEdit.Text)); + b := round(StrToFloat(FreqBEdit.Text)); + p := StrToFloat(PropAEdit.Text); + N := A + b; + Q := 1.0 - p; + + lReport := TStringList.Create; + try + lReport.Add('BINOMIAL PROBABILITY TEST'); + lReport.Add(''); + lReport.Add('Frequency of %d out of %d observed', [A, N]); + lReport.Add('The theoretical proportion expected in category A is %.3f', [p]); + lReport.Add(''); + lReport.Add('The test is for the probability of a value in category A as small or smaller'); + lReport.Add('than that observed given the expected proportion.'); + + if (N > 35) then //Use normal distribution approximation + begin + CorrectedA := A; + if A < N * p then CorrectedA := A + 0.5; + if A > N * p then CorrectedA := A - 0.5; + z := (CorrectedA - N * p) / sqrt(N * p * Q); + lReport.Add('Z value for Normal Distribution approximation: %.3f', [z]); + Probability := probz(z); + lReport.Add('Probability: %.4f', [Probability]); + end + else //Use binomial fomula + begin + for X := 0 to A do + begin + Probability := combos(X, N) * Power(p,X) * Power(Q,(N - X)); + lReport.Add('Probability of %d = %6.4f', [X, Probability]); + SumProb := SumProb + Probability; + end; + lReport.Add('Binomial Probability of %d or less out of %d: %.4f', [A, N, SumProb]); + end; + + DisplayReport(lReport); + finally + lReport.Free; + end; + + if PlotChk.Checked then + begin + if N <= 35 then + begin + SetLength(GraphFrm.Xpoints,1,N+1); + SetLength(GraphFrm.Ypoints,1,N+1); + for i := 0 to N do + begin + GraphFrm.Xpoints[0,i] := i; + Probability := combos(i,N) * power(p,i) * power(Q,(N-i)); + GraphFrm.Ypoints[0,i] := Probability; + end; + GraphFrm.GraphType := 2; + GraphFrm.nosets := 1; + GraphFrm.nbars := N; + GraphFrm.BackColor := clCream; + GraphFrm.WallColor := clDkGray; + GraphFrm.FloorColor := clGray; + GraphFrm.Heading := 'Binomial Distribution'; + GraphFrm.XTitle := 'Values'; + GraphFrm.YTitle := 'Probability'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := true; + GraphFrm.ShowLeftWall := true; + GraphFrm.ShowRightWall := true; + GraphFrm.ShowBottomWall := true; + GraphFrm.ShowModal; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; + end else + MessageDlg('Cannot plot for N > 35', mtInformation, [mbOK], 0); + end; +end; + +function TBinomialFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + x: Double; +begin + Result := false; + if (FreqAEdit.Text = '') or (FreqBEdit.Text = '') or (PropAEdit.Text = '') then + begin + AMsg := 'Value not specified.'; + if FreqAEdit.Text = '' then AControl := FreqAEdit; + if FreqBEdit.Text = '' then AControl := FreqBEdit; + if PropAEdit.Text = '' then AControl := PropAEdit; + exit; + end; + if not TryStrToFloat(FreqAEdit.Text, x) then + begin + AMsg := 'No valid number.'; + AControl := FreqAEdit; + exit; + end; + if not TryStrToFloat(FreqBEdit.Text, x) then + begin + AMsg := 'No valid number.'; + AControl := FreqBEdit; + exit; + end; + if not TryStrToFloat(PropAEdit.Text, x) then + begin + AMsg := 'No valid number.'; + AControl := PropAEdit; + exit; + end; + + Result := true; +end; + +initialization + {$I binomialunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/chisqrunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/chisqrunit.lfm new file mode 100644 index 000000000..7ac468e5f --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/chisqrunit.lfm @@ -0,0 +1,428 @@ +object ChiSqrFrm: TChiSqrFrm + Left = 425 + Height = 566 + Top = 216 + Width = 474 + AutoSize = True + Caption = 'Contingency Chi Squared' + ClientHeight = 566 + ClientWidth = 474 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = InputGrp + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 109 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = RowEdit + AnchorSideBottom.Control = RowEdit + Left = 265 + Height = 15 + Top = 134 + Width = 67 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Row Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = ColEdit + AnchorSideBottom.Control = ColEdit + Left = 265 + Height = 15 + Top = 214 + Width = 87 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Column Variable' + ParentColor = False + end + object AnalyzeLabel: TLabel + AnchorSideLeft.Control = DepEdit + AnchorSideBottom.Control = DepEdit + Left = 265 + Height = 15 + Top = 294 + Width = 99 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Variable to Analyze' + ParentColor = False + end + object NCasesLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = NCasesEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NCasesEdit + Left = 8 + Height = 15 + Top = 498 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Total No. of Cases:' + ParentColor = False + end + object InputGrp: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 93 + Top = 8 + Width = 458 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Input Options' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 73 + ClientWidth = 454 + Items.Strings = ( + 'Count vases classified by row and column vectors in the data grid' + 'Use frequencies recorded in the data grid for row and column variables' + 'Use proportions recorded in the data grid for row and column variables' + ) + OnClick = InputGrpClick + TabOrder = 0 + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = RowIn + AnchorSideBottom.Control = NCasesEdit + Left = 8 + Height = 360 + Top = 126 + Width = 213 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 1 + end + object RowIn: TBitBtn + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = VarList + Left = 229 + Height = 28 + Top = 126 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = RowInClick + Spacing = 0 + TabOrder = 2 + end + object RowOut: TBitBtn + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = RowIn + AnchorSideTop.Side = asrBottom + Left = 229 + Height = 28 + Top = 158 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = RowOutClick + Spacing = 0 + TabOrder = 3 + end + object ColIn: TBitBtn + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = RowOut + AnchorSideTop.Side = asrBottom + Left = 229 + Height = 28 + Top = 206 + Width = 28 + BorderSpacing.Top = 20 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ColInClick + Spacing = 0 + TabOrder = 5 + end + object ColOut: TBitBtn + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = ColIn + AnchorSideTop.Side = asrBottom + Left = 229 + Height = 28 + Top = 238 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ColOutClick + Spacing = 0 + TabOrder = 6 + end + object DepIn: TBitBtn + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = ColOut + AnchorSideTop.Side = asrBottom + Left = 229 + Height = 28 + Top = 286 + Width = 28 + BorderSpacing.Top = 20 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInClick + Spacing = 0 + TabOrder = 8 + end + object DepOut: TBitBtn + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = DepIn + AnchorSideTop.Side = asrBottom + Left = 229 + Height = 28 + Top = 318 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutClick + Spacing = 0 + TabOrder = 9 + end + object RowEdit: TEdit + AnchorSideLeft.Control = RowOut + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = RowOut + AnchorSideBottom.Side = asrBottom + Left = 265 + Height = 23 + Top = 151 + Width = 201 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 4 + Text = 'RowEdit' + end + object ColEdit: TEdit + AnchorSideLeft.Control = ColIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ColOut + AnchorSideBottom.Side = asrBottom + Left = 265 + Height = 23 + Top = 231 + Width = 201 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 7 + Text = 'ColEdit' + end + object DepEdit: TEdit + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOut + AnchorSideBottom.Side = asrBottom + Left = 265 + Height = 23 + Top = 311 + Width = 201 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 10 + Text = 'DepEdit' + end + object NCasesEdit: TEdit + AnchorSideLeft.Control = NCasesLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = OptionsGroup + AnchorSideBottom.Control = Bevel1 + Left = 113 + Height = 23 + Top = 494 + Width = 69 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 11 + Text = 'NCasesEdit' + end + object OptionsGroup: TGroupBox + AnchorSideTop.Control = DepOut + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 229 + Height = 152 + Top = 362 + Width = 237 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + Caption = 'Output Options:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 4 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 132 + ClientWidth = 233 + TabOrder = 12 + object ObsChk: TCheckBox + Left = 12 + Height = 19 + Top = 4 + Width = 209 + Caption = 'Show Observed Frequencies' + TabOrder = 0 + end + object ExpChk: TCheckBox + Left = 12 + Height = 19 + Top = 25 + Width = 209 + Caption = 'Show Expected Frequencies' + TabOrder = 1 + end + object PropsChk: TCheckBox + Left = 12 + Height = 19 + Top = 46 + Width = 209 + Caption = 'Show Row and Column Proportions' + TabOrder = 2 + end + object CellChiChk: TCheckBox + Left = 12 + Height = 19 + Top = 67 + Width = 209 + Caption = 'Show Cell Chi-Squared Values' + TabOrder = 3 + end + object YatesChk: TCheckBox + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 19 + Top = 88 + Width = 209 + Caption = 'Use Yates Correction' + TabOrder = 5 + end + object SaveFChk: TCheckBox + Left = 12 + Height = 19 + Top = 109 + Width = 209 + Caption = 'Save a File of Frequency Data' + TabOrder = 4 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 265 + Height = 25 + Top = 533 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 13 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 327 + Height = 25 + Top = 533 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 14 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 411 + Height = 25 + Top = 533 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 15 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 517 + Width = 474 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/chisqrunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/chisqrunit.pas new file mode 100644 index 000000000..a90f363ce --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/chisqrunit.pas @@ -0,0 +1,631 @@ +unit ChiSqrUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, Buttons, + MainUnit, OutputUnit, FunctionsLib, GraphLib, Globals, MatrixLib, + DataProcs, DictionaryUnit; + +type + + { TChiSqrFrm } + + TChiSqrFrm = class(TForm) + Bevel1: TBevel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + ObsChk: TCheckBox; + ExpChk: TCheckBox; + PropsChk: TCheckBox; + CellChiChk: TCheckBox; + SaveFChk: TCheckBox; + OptionsGroup: TGroupBox; + YatesChk: TCheckBox; + RowIn: TBitBtn; + RowOut: TBitBtn; + ColIn: TBitBtn; + ColOut: TBitBtn; + DepIn: TBitBtn; + DepOut: TBitBtn; + NCasesEdit: TEdit; + NCasesLabel: TLabel; + RowEdit: TEdit; + ColEdit: TEdit; + DepEdit: TEdit; + InputGrp: TRadioGroup; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + AnalyzeLabel: TLabel; + VarList: TListBox; + procedure ColInClick(Sender: TObject); + procedure ColOutClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure DepInClick(Sender: TObject); + procedure DepOutClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InputGrpClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure RowInClick(Sender: TObject); + procedure RowOutClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + ChiSqrFrm: TChiSqrFrm; + +implementation + +uses + Math; + +{ TChiSqrFrm } + +procedure TChiSqrFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + RowEdit.Text := ''; + ColEdit.Text := ''; + DepEdit.Text := ''; + DepEdit.Enabled := false; + NCasesLabel.Enabled := false; + AnalyzeLabel.Enabled := false; + NCasesEdit.Text := ''; + NCasesEdit.Enabled := false; + InputGrp.ItemIndex := 0; + ObsChk.Checked := false; + ExpChk.Checked := false; + PropsChk.Checked := false; + CellChiChk.Checked := false; + SaveFChk.Checked := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TChiSqrFrm.RowInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (RowEdit.Text = '') then + begin + RowEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TChiSqrFrm.RowOutClick(Sender: TObject); +begin + if RowEdit.Text <> '' then + begin + VarList.Items.Add(RowEdit.Text); + RowEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TChiSqrFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TChiSqrFrm.ColInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (ColEdit.Text = '') then + begin + ColEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TChiSqrFrm.ColOutClick(Sender: TObject); +begin + if ColEdit.Text <> '' then + begin + VarList.Items.Add(ColEdit.Text); + ColEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TChiSqrFrm.ComputeBtnClick(Sender: TObject); +var + i, j, RowNo, ColNo, DepNo, MinRow, MaxRow, MinCol, MaxCol : integer; + Row, Col, NoSelected, Ncases, Nrows, Ncols, FObs, df : integer; + RowLabels, ColLabels : StrDyneVec; + ColNoSelected : IntDyneVec; + cellstring: string; + Freq : IntDyneMat; + Prop, Expected, CellChi : DblDyneMat; + PObs, ChiSquare, ProbChi, phi, SumX, SumY, VarX, VarY, liklihood : double; + yates : boolean; + title : string; + Adjchisqr, probliklihood, G, pearsonr, MantelHaenszel, MHprob : double; + Adjprobchi, CoefCont, CramerV : double; + lReport: TStrings; +begin + if RowEdit.Text = '' then + begin + MessageDlg('Row variable not selected.', mtError, [mbOK], 0); + exit; + end; + if ColEdit.Text = '' then + begin + MessageDlg('Column variable not selected.', mtError, [mbOK], 0); + exit; + end; + if DepEdit.Text = '' then + begin + MessageDlg('Variable to analyze is not selected', mtError, [mbOK], 0); + exit; + end; + if InputGrp.ItemIndex = 2 then + begin + if NCasesEdit.Text = '' then + begin + NCasesEdit.SetFocus; + MessageDlg('Total number of cases not selected.', mtError, [mbOk], 0); + exit; + end; + if not TryStrToInt(NCasesEdit.Text, i) then + begin + NCasesEdit.SetFocus; + Messagedlg('Numberical input expected for total number of cases.', mtError, [mbOK], 0); + exit; + end; + end; + + SetLength(ColNoSelected,NoVariables); + yates := false; + RowNo := 0; + ColNo := 0; + DepNo := 0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = RowEdit.Text then RowNo := i; + if cellstring = ColEdit.Text then ColNo := i; + if cellstring = DepEdit.Text then DepNo := i; + end; + ColNoSelected[0] := RowNo; + ColNoSelected[1] := ColNo; + NoSelected := 2; + if InputGrp.ItemIndex > 0 then // for reading proportions or frequencies + begin + NoSelected := 3; + ColNoSelected[2] := DepNo; + end; + // get min and max of row and col numbers + MinRow := 1000; + MaxRow := 0; + MinCol := 1000; + MaxCol := 0; + for i := 1 to NoCases do + begin + if NOT GoodRecord(i,NoSelected,ColNoSelected) then continue; + Row := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[RowNo,i]))); + Col := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNo,i]))); + if Row > MaxRow then MaxRow := Row; + if Row < MinRow then MinRow := Row; + if Col > MaxCol then MaxCol := Col; + if Col < MinCol then MinCol := Col; + end; + Nrows := MaxRow - MinRow + 1; + Ncols := MaxCol - MinCol + 1; + + // allocate and initialize + SetLength(Freq,Nrows+1,Ncols+1); + SetLength(Prop,Nrows+1,Ncols+1); + SetLength(Expected,Nrows,Ncols); + SetLength(CellChi,Nrows,Ncols); + SetLength(RowLabels,Nrows+1); + SetLength(ColLabels,Ncols+1); + for i := 1 to Nrows + 1 do + for j := 1 to Ncols + 1 do Freq[i-1,j-1] := 0; + + // get cell data + NCases := 0; + case InputGrp.ItemIndex of + 0 : begin // count number of cases in each row and column combination + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + NCases := NCases + 1; + Row := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[RowNo,i]))); + Col := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNo,i]))); + Row := Row - MinRow + 1; + Col := Col - MinCol + 1; + Freq[Row-1,Col-1] := Freq[Row-1,Col-1] + 1; + end; + end; + 1 : begin // read frequencies data from grid + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + Row := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[RowNo,i]))); + Col := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNo,i]))); + Row := Row - MinRow + 1; + Col := Col - MinCol + 1; + FObs := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepNo,i]))); + Freq[Row-1,Col-1] := Freq[Row-1,Col-1] + FObs; + NCases := NCases + FObs; + end; + end; + 2 : begin // get no. of cases and proportions for each cell + NCases := StrToInt(NCasesEdit.Text); + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + Row := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[RowNo,i]))); + Col := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNo,i]))); + Row := Row - MinRow + 1; + Col := Col - MinCol + 1; + PObs := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepNo,i])); + Freq[Row-1,Col-1] := Freq[Row-1,Col-1] + round(PObs * NCases); + end; + end; + end; // end case + Freq[Nrows,Ncols] := NCases; + + // Now, calculate expected values + // Get row totals first + for i := 1 to Nrows do + for j := 1 to Ncols do + Freq[i-1,Ncols] := Freq[i-1,Ncols] + Freq[i-1,j-1]; + // Get col totals next + for j := 1 to Ncols do + for i := 1 to Nrows do + Freq[Nrows,j-1] := Freq[Nrows,j-1] + Freq[i-1,j-1]; + // Then get expected values and cell chi-squares + ChiSquare := 0.0; + AdjChisqr := 0.0; + if (YatesChk.Checked) and (Nrows = 2) and (Ncols = 2) then yates := true; + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + Expected[i-1,j-1] := Freq[Nrows,j-1] * Freq[i-1,Ncols] / NCases; + if Expected[i-1,j-1] > 0.0 then + CellChi[i-1,j-1] := sqr(Freq[i-1,j-1] - Expected[i-1,j-1]) / Expected[i-1,j-1] + else begin + MessageDlg('Zero expected value found.', mtError, [mbOK], 0); + CellChi[i-1,j-1] := 0.0; + end; + ChiSquare := ChiSquare + CellChi[i-1,j-1]; + end; + end; + df := (Nrows - 1) * (Ncols - 1); + if yates = true then // 2 x 2 corrected chi-square + begin + Adjchisqr := abs((Freq[0,0] * Freq[1,1]) - (Freq[0,1] * Freq[1,0])); + Adjchisqr := sqr(Adjchisqr - NCases / 2.0) * NCases; // numerator + Adjchisqr := Adjchisqr / (Freq[0,2] * Freq[1,2] * Freq[2,0] * Freq[2,1]); + Adjprobchi := 1.0 - chisquaredprob(Adjchisqr,df); + end; + ProbChi := 1.0 - chisquaredprob(ChiSquare,df); // prob. larger chi + + //Print results to output form + lReport := TStringList.Create; + try + lReport.Add('CHI-SQUARE ANALYSIS RESULTS'); + + // print tables requested by use + for i := 1 to Nrows do RowLabels[i-1] := Format('Row %d', [i]); + RowLabels[Nrows] := 'Total'; + for j := 1 to Ncols do ColLabels[j-1] := Format('COL.%d', [j]); + ColLabels[Ncols] := 'Total'; + + if ObsChk.Checked then + begin + IntArrayPrint(Freq, Nrows+1, Ncols+1,'Rows', + RowLabels, ColLabels,'OBSERVED FREQUENCIES', lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + end; + + if ExpChk.Checked then + begin + title := 'EXPECTED FREQUENCIES'; + MatPrint(Expected,Nrows,Ncols,title,RowLabels,ColLabels,NCases, lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + end; + + if PropsChk.Checked then + begin + title := 'ROW PROPORTIONS'; + for i := 1 to Nrows + 1 do + begin + for j := 1 to Ncols do + begin + if Freq[i-1,Ncols] > 0.0 then + Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[i-1,Ncols] + else Prop[i-1,j-1] := 0.0; + end; + if Freq[i-1,Ncols] > 0.0 then Prop[i-1,Ncols] := 1.0 + else Prop[i-1,Ncols] := 0.0; + end; + MatPrint(Prop,Nrows+1,Ncols+1,title,RowLabels,ColLabels,NCases, lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + title := 'COLUMN PROPORTIONS'; + for j := 1 to Ncols + 1 do + begin + for i := 1 to Nrows do + begin + if Freq[Nrows,j-1] > 0.0 then + Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[Nrows,j-1] + else Prop[i-1,j-1] := 0.0; + end; + if Freq[Nrows,j-1] > 0.0 then Prop[NRows,j-1] := 1.0 + else Prop[NRows,j-1] := 0.0; + end; + MatPrint(Prop,Nrows+1,Ncols+1,title,RowLabels,ColLabels,NCases, lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + Title := 'PROPORTIONS OF TOTAL N'; + for i := 1 to Nrows + 1 do + for j := 1 to Ncols + 1 do Prop[i-1,j-1] := Freq[i-1,j-1] / NCases; + Prop[Nrows,Ncols] := 1.0; + MatPrint(Prop,Nrows+1,Ncols+1,title,RowLabels,ColLabels,NCases, lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + end; + + if CellChiChk.Checked then + begin + title := 'CHI-SQUARED VALUE FOR CELLS'; + MatPrint(CellChi,Nrows,Ncols,title,RowLabels,ColLabels,NCases, lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + end; + + lReport.Add('Chi-square: %.3f with D.F. = %d. Prob. > value %.3f', [ChiSquare, df, ProbChi]); + lReport.Add(''); + if yates then + lReport.Add('Chi-square using Yates correction: %.3f and Prob > value: %.3f', [Adjchisqr, Adjprobchi]); + + liklihood := 0.0; + for i := 0 to Nrows-1 do + for j := 0 to Ncols-1 do + if (Freq[i,j] > 0.0) then + liklihood := Liklihood + (Freq[i,j] * (ln(Expected[i,j] / Freq[i,j]))); + liklihood := -2.0 * liklihood; + probliklihood := 1.0 - chisquaredprob(liklihood,df); + lReport.Add('Likelihood Ratio: %.3f with prob. > value %.4f', [liklihood, probliklihood]); + + G := 0.0; + for i := 0 to Nrows-1 do + for j := 0 to Ncols-1 do + if (Expected[i,j] > 0) then + G := G + Freq[i,j] * (ln(Freq[i,j] / Expected[i,j])); + G := 2.0 * G; + probliklihood := 1.0 - chisquaredprob(G,df); + lReport.Add('G statistic: %.3f with prob. > value %.4f', [G, probliklihood]); + + if ((Nrows > 1) and (Ncols > 1)) then + begin + phi := sqrt(ChiSquare / Ncases); + lReport.Add('phi correlation: %.4f', [phi]); + lReport.Add(''); + + pearsonr := 0.0; + SumX := 0.0; + SumY := 0.0; + VarX := 0.0; + VarY := 0.0; + for i := 0 to Nrows-1 do SumX := SumX + ( (i+1) * Freq[i,Ncols] ); + for j := 0 to Ncols-1 do SumY := SumY + ( (j+1) * Freq[Nrows,j] ); + for i := 0 to Nrows-1 do VarX := VarX + ( ((i+1)*(i+1)) * Freq[i,Ncols] ); + for j := 0 to Ncols-1 do VarY := VarY + ( ((j+1)*(j+1)) * Freq[Nrows,j] ); + VarX := VarX - ((SumX * SumX) / Ncases); + VarY := VarY - ((SumY * SumY) / Ncases); + for i := 0 to Nrows-1 do + for j := 0 to Ncols-1 do + pearsonr := pearsonr + ((i+1)*(j+1) * Freq[i,j]); + pearsonr := pearsonr - (SumX * SumY / Ncases); + pearsonr := pearsonr / sqrt(VarX * VarY); + lReport.Add('Pearson Correlation r: %.4f', [pearsonr]); + lReport.Add(''); + + MantelHaenszel := (Ncases-1) * (pearsonr * pearsonr); + MHprob := 1.0 - chisquaredprob(MantelHaenszel,1); + lReport.Add('Mantel-Haenszel Test of Linear Association: %.3f with probability > value %.4f', [MantelHaenszel, MHprob]); + lReport.Add(''); + + CoefCont := sqrt(ChiSquare / (ChiSquare + Ncases)); + lReport.Add('The coefficient of contingency: %.3f', [CoefCont]); + lReport.Add(''); + + if (Nrows < Ncols) then + CramerV := sqrt(ChiSquare / (Ncases * ((Nrows-1)))) + else + CramerV := sqrt(ChiSquare / (Ncases * ((Ncols-1)))); + lReport.Add('Cramers V: %.3f', [CramerV]); + lReport.Add(''); + end; + + DisplayReport(lReport); + finally + lReport.Free; + end; + + // save frequency data file if elected + if SaveFChk.Checked then + begin + OS3MainFrm.CloseFileBtnClick(self); + OS3MainFrm.FileNameEdit.Text := ''; + for i := 1 to DictionaryFrm.DictGrid.RowCount - 1 do + for j := 0 to 7 do DictionaryFrm.DictGrid.Cells[j,i] := ''; + DictionaryFrm.DictGrid.RowCount := 1; +// DictionaryFrm.FileNameEdit.Text := ''; + + // get labels for new file + ColLabels[0] := 'ROW'; + ColLabels[1] := 'COL'; + ColLabels[2] := 'FREQ'; + // create new variables + Row := 0; + OS3MainFrm.DataGrid.ColCount := 4; + DictionaryFrm.DictGrid.ColCount := 8; + NoVariables := 0; + for i := 1 to 3 do + begin + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := ColLabels[i-1]; + OS3MainFrm.DataGrid.Cells[col,0] := ColLabels[i-1]; + NoVariables := NoVariables + 1; + end; + OS3MainFrm.DataGrid.RowCount := (Nrows * NCols) + 1; + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + Row := Row + 1; + OS3MainFrm.DataGrid.Cells[0,Row] := Format('Case:%d',[Row]); + OS3MainFrm.DataGrid.Cells[1,Row] := IntToStr(i); + OS3MainFrm.DataGrid.Cells[2,Row] := IntToStr(j); + OS3MainFrm.DataGrid.Cells[3,Row] := IntToStr(Freq[i-1,j-1]); + end; + end; + NoCases := Row; + OS3MainFrm.FileNameEdit.Text := 'ChiSqrFreq.LAZ'; + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); +// OS3MainFrm.SaveFileBtnClick(self); + end; + + //clean up + ColLabels := nil; + RowLabels := nil; + CellChi := nil; + Expected := nil; + Prop := nil; + Freq := nil; + ColNoSelected := nil; + ResetBtnClick(self); +end; + +procedure TChiSqrFrm.DepInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepEdit.Text = '') then + begin + DepEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TChiSqrFrm.DepOutClick(Sender: TObject); +begin + if DepEdit.Text <> '' then + begin + VarList.Items.Add(DepEdit.Text); + DepEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TChiSqrFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinHeight := + OptionsGroup.Top + OptionsGroup.Height - VarList.Top - NCasesEdit.Height - NCasesEdit.BorderSpacing.Top; + Constraints.MinWidth := OptionsGroup.Width * 2 + 3 * VarList.BorderSpacing.Left; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TChiSqrFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TChiSqrFrm.InputGrpClick(Sender: TObject); +begin + case InputGrp.ItemIndex of + 0: begin // have to count cases in each row and col. combination + NCasesLabel.Enabled := false; + NCasesEdit.Enabled := false; + DepIn.Enabled := false; + DepOut.Enabled := false; + DepEdit.Enabled := false; + end; + 1: begin // frequencies available for each row and column combo + NCasesLabel.Enabled := false; + NCasesEdit.Enabled := false; + DepIn.Enabled := true; + DepEdit.Enabled := true; + AnalyzeLabel.Enabled := true; + end; + 2: begin // only proportions available - get N size + NCasesLabel.Enabled := true; + AnalyzeLabel.Enabled := true; + NCasesEdit.Enabled := true; + NCasesEdit.SetFocus; + DepIn.Enabled := true; + DepOut.Enabled := false; + DepEdit.Enabled := true; + end; + end; +end; + +procedure TChiSqrFrm.UpdateBtnStates; +begin + RowIn.Enabled := (VarList.Items.Count > 0) and (RowEdit.Text = ''); + ColIn.Enabled := (VarList.Items.Count > 0) and (ColEdit.Text = ''); + DepIn.Enabled := (VarList.Items.Count > 0) and (DepEdit.Text = ''); + + RowOut.Enabled := (RowEdit.Text <> ''); + ColOut.Enabled := (ColEdit.Text <> ''); + DepOut.Enabled := (DepEdit.Text <> ''); +end; + +procedure TChiSqrFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + + +initialization + {$I chisqrunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/cochranqunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/cochranqunit.lfm new file mode 100644 index 000000000..db3d5d158 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/cochranqunit.lfm @@ -0,0 +1,209 @@ +object CochranQFrm: TCochranQFrm + Left = 562 + Height = 344 + Top = 203 + Width = 414 + AutoSize = True + Caption = 'Cochran Q Test' + ClientHeight = 344 + ClientWidth = 414 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = VarList + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Top = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = SelList + AnchorSideTop.Control = Owner + Left = 238 + Height = 15 + Top = 8 + Width = 93 + BorderSpacing.Top = 8 + Caption = 'Selected Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 270 + Top = 25 + Width = 168 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 193 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 193 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = OutBtn + AnchorSideTop.Side = asrBottom + Left = 184 + Height = 25 + Top = 89 + Width = 46 + AutoSize = True + BorderSpacing.Top = 4 + Caption = 'ALL' + OnClick = AllBtnClick + TabOrder = 3 + end + object SelList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 238 + Height = 270 + Top = 25 + Width = 168 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 4 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 205 + Height = 25 + Top = 311 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 6 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 267 + Height = 25 + Top = 311 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 7 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 351 + Height = 25 + Top = 311 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 8 + end + object HelpBtn: TButton + Tag = 113 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 146 + Height = 25 + Top = 311 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 5 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 295 + Width = 414 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/cochranqunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/cochranqunit.pas new file mode 100644 index 000000000..f7243a172 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/cochranqunit.pas @@ -0,0 +1,271 @@ +unit CochranQUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, OutputUnit, DataProcs, FunctionsLib, contexthelpunit; + +type + + { TCochranQFrm } + + TCochranQFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + InBtn: TBitBtn; + Label2: TLabel; + SelList: TListBox; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + Label1: TLabel; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + CochranQFrm: TCochranQFrm; + +implementation + +uses + Math; + +{ TCochranQFrm } + +procedure TCochranQFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + SelList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TCochranQFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TCochranQFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TCochranQFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TCochranQFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TCochranQFrm.AllBtnClick(Sender: TObject); +var + index: integer; +begin + for index := 0 to VarList.Items.Count - 1 do + SelList.Items.Add(VarList.Items[index]); + UpdateBtnStates; +end; + +procedure TCochranQFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, col : integer; + ColNoSelected : IntDyneVec; + R1, L1, L2, C1, g1, Q, g2, chiprob : double; + cellstring, outline : string; + lReport: TStrings; +begin + if SelList.Items.Count = 0 then + begin + MessageDlg('No variable(s) selected.', mtError, [mbOK], 0); + exit; + end; + + SetLength(ColNoSelected,NoVariables); + C1 := 0.0; + k := SelList.Items.Count; + + // Get column numbers and labels of variables selected + for i := 1 to k do + begin + cellstring := SelList.Items.Strings[i-1]; + for j := 1 to NoVariables do + if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then + ColNoSelected[i-1] := j; + end; + + // Calculate results + R1 := 0.0; + L1 := 0.0; + L2 := 0.0; + g1 := 0.0; + g2 := 0.0; + for i := 1 to NoCases do + begin + if (not GoodRecord(i,k,ColNoSelected)) then continue; + for j := 1 to k do + begin + col := ColNoSelected[j-1]; + R1 := R1 + StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); + end; + L1 := L1 + R1; + L2 := L2 + (R1 * R1); + R1 := 0.0; + end; + + for j := 1 to k do + begin + for i := 1 to NoCases do + begin + if (not GoodRecord(i,k,ColNoSelected)) then continue; + col := ColNoSelected[j-1]; + C1 := C1 + StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); + end; + g1 := g1 + C1; + g2 := g2 + (C1 * C1); + C1 := 0.0; + end; + + if (k * L1 - L2) > 0.0 then + begin + Q := ((k - 1) * ((k * g2) - (g1 * g1))) / ((k * L1) - L2); + chiprob := 1.0 - chisquaredprob(Q, k - 1); + end else + begin + Q := 0.0; + chiprob := 1.0; + Messagedlg('Error in obtaining Q and the probability.', mtError, [mbOK], 0); + end; + + //present results + lReport := TStringList.Create; + try + lReport.Add('COCHRAN Q TEST FOR RELATED SAMPLES'); + lReport.Add('See pages 161-166 in S. Siegel: Nonparametric Statistics for the Behavioral Sciences'); + lReport.Add('McGraw-Hill Book Company, New York, 1956'); + lReport.Add(''); + lReport.Add('Cochran Q Statistic: %6.3f', [Q]); + lReport.Add('which is distributed as chi-square with %d D.F. and probability %.4f', [k-1, chiprob]); + DisplayReport(lReport); + finally + lReport.Free; + ColNoSelected := nil; + end; +end; + +procedure TCochranQFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + SelList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TCochranQFrm.OutBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < SelList.Items.Count do + begin + if SelList.Selected[i] then + begin + VarList.Items.Add(SelList.Items[i]); + SelList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TCochranQFrm.UpdateBtnStates; +var + i: Integer; + lSelected: Boolean; +begin + lSelected := false; + for i:=0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + InBtn.Enabled := lSelected; + + lSelected := false; + for i:=0 to SelList.Items.Count-1 do + if SelList.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; + + AllBtn.Enabled := VarList.Items.Count > 0; +end; + +procedure TCochranQFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + + +initialization + {$I cochranqunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/concordanceunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/concordanceunit.lfm new file mode 100644 index 000000000..6be60eff2 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/concordanceunit.lfm @@ -0,0 +1,205 @@ +object ConcordFrm: TConcordFrm + AnchorSideBottom.Side = asrBottom + Left = 535 + Height = 310 + Top = 327 + Width = 397 + Anchors = [akLeft] + AutoSize = True + Caption = 'Kendal''s Coefficient of Concordance' + ClientHeight = 310 + ClientWidth = 397 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = VarList + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Top = 8 + Caption = 'Avialable Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = SelList + AnchorSideTop.Control = Owner + Left = 229 + Height = 15 + Top = 8 + Width = 93 + BorderSpacing.Top = 8 + Caption = 'Selected Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 236 + Top = 25 + Width = 159 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 184 + Height = 28 + Top = 24 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 184 + Height = 28 + Top = 56 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 175 + Height = 25 + Top = 104 + Width = 46 + AutoSize = True + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 3 + end + object SelList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 229 + Height = 236 + Top = 25 + Width = 160 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 4 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 188 + Height = 25 + Top = 277 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 6 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 250 + Height = 25 + Top = 277 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 7 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 334 + Height = 25 + Top = 277 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 8 + end + object HelpBtn: TButton + Tag = 115 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 129 + Height = 25 + Top = 277 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 5 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 261 + Width = 397 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/concordanceunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/concordanceunit.pas new file mode 100644 index 000000000..f63e7224a --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/concordanceunit.pas @@ -0,0 +1,424 @@ +unit ConcordanceUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, OutputUnit, DataProcs, FunctionsLib, ContextHelpUnit; + +type + + { TConcordFrm } + + TConcordFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + InBtn: TBitBtn; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + Label1: TLabel; + Label2: TLabel; + SelList: TListBox; + VarList: TListBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + ConcordFrm: TConcordFrm; + +implementation + +uses + Math; + +{ TConcordFrm } + +procedure TConcordFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + SelList.Clear; + for i := 1 to NoVariables do + begin + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + end; + InBtn.Enabled := true; + OutBtn.Enabled := false; +end; + +procedure TConcordFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := false; +end; + +procedure TConcordFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TConcordFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TConcordFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TConcordFrm.AllBtnClick(Sender: TObject); +var + index: integer; +begin + for index := 0 to VarList.Count-1 do + SelList.Items.Add(VarList.Items[index]); + VarList.Clear; + UpdateBtnStates; +end; + +procedure TConcordFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, index, No_Judges, No_Objects, col, ties, start, last : integer; + Temp, TotalCorrect, JudgeCorrect, ChiSquare, Probability : double; + TotalRankSums, Concordance, AvgRankCorr, AvgTotalRanks : double; + statistic : double; + scorearray : DblDyneMat; + temprank, ObjRankSums : DblDyneVec; + tempindex : IntDyneVec; + done : boolean; + value, cellstring, outline : string; + ColNoSelected : IntDyneVec; + ColLabels : StrDyneVec; + lReport: TStrings; +begin + if SelList.Items.Count = 0 then + begin + MessageDlg('No variables selected.', mtError, [mbOK], 0); + exit; + end; + + No_Judges := 0; + No_Objects := SelList.Items.Count; + + // Allocate space for selected variable column no.s + SetLength(scorearray, NoCases, No_Objects); + SetLength(tempindex, No_Objects); + SetLength(temprank, No_Objects); + SetLength(ObjRankSums, No_Objects); + SetLength(ColLabels, NoVariables); + SetLength(ColNoSelected, NoVariables); + + // get columns of variables selected + for i := 0 to No_Objects - 1 do + begin + cellstring := SelList.Items.Strings[i]; + for index := 1 to NoVariables do + begin + if (cellstring = OS3MainFrm.DataGrid.Cells[index,0]) then + begin + ColNoSelected[i] := index; + ColLabels[i] := cellstring; + end; + end; + end; + + //Read data from grid + for i := 1 to NoCases do + begin + if (not GoodRecord(i,No_Objects,ColNoSelected)) then continue; + No_Judges := No_Judges + 1; + for j := 1 to No_Objects do + begin + col := ColNoSelected[j-1]; + scorearray[i-1,j-1] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); + end; + end; + + //Rank the scores in the rows for each judge (column) + TotalCorrect := 0.0; + for i := 0 to No_Judges-1 do + begin + JudgeCorrect := 0.0; + for j := 0 to No_Objects-1 do + begin + tempindex[j] := j; + temprank[j] := scorearray[i,j]; + end; + //Sort the temp arrays + for j := 0 to No_Objects - 2 do + begin + for k := j + 1 to No_Objects - 1 do + begin + if (temprank[j] > temprank[k]) then + begin + Temp := temprank[j]; + temprank[j] := temprank[k]; + temprank[k] := Temp; + index := tempindex[j]; + tempindex[j] := tempindex[k]; + tempindex[k] := index; + end; + end; + end; + + //Now convert temporary score array to ranks (correcting for ties) + j := 0; + while (j <= No_Objects-1) do + begin + ties := 0; + k := j; + done := false; + while (not done) do + begin + k := k + 1; + if (k <= No_Objects-1) then + begin + if (temprank[j] = temprank[k]) then ties := ties + 1; + end + else done := true; + end; + if (ties = 0.0) then + begin + temprank[j] := j+1; + j := j + 1; + end + else begin + for k := j to j + ties do + begin + temprank[k] := (j+1) + (ties / 2.0); + end; + j := j + ties + 1; + ties := ties + 1; + JudgeCorrect := JudgeCorrect + (Power(ties,3) - ties); + end; + end; + + //Now, restore ranks in their position equivalent to original scores + for j := 0 to No_Objects-1 do + begin + k := tempindex[j]; + scorearray[i,k] := temprank[j]; + end; + TotalCorrect := TotalCorrect + (JudgeCorrect / 12.0); + end; // next judge i + + //Calculate statistics + statistic := 0.0; + TotalRankSums := 0.0; + for j := 0 to No_Objects-1 do + begin + ObjRankSums[j] := 0.0; + for i := 0 to No_Judges-1 do + ObjRankSums[j] := ObjRankSums[j] + scorearray[i,j]; + TotalRankSums := TotalRankSums + ObjRankSums[j]; + end; + AvgTotalRanks := TotalRankSums / No_Objects; + for j := 0 to No_Objects-1 do + statistic := statistic + Power((ObjRankSums[j] - AvgTotalRanks), 2); + Concordance := statistic / ( ((No_Judges * No_Judges) / 12.0) * + (Power(No_Objects,3) - No_Objects) - (No_Judges * TotalCorrect) ); + AvgRankCorr := (No_Judges * Concordance - 1.0) / (No_Judges - 1); + ChiSquare := No_Judges * Concordance * (No_Objects - 1); + Probability := 1.0 - chisquaredprob(ChiSquare, No_Objects - 1); + + //Report results + lReport := TStringList.Create; + try + lReport.Add('KENDALL COEFFICIENT OF CONCORDANCE ANALYSIS'); + lReport.Add(''); + lReport.Add('Ranks Assigned to Judge Ratings of Objects'); + lReport.Add(''); + + for i := 1 to No_Judges do + begin + done := false; + start := 1; + last := 10; + while not done do + begin + if (last > No_Objects)then last := No_Objects; + outline := format('Judge %3d',[i]); + outline := outline + ' Objects'; + lReport.Add(outline); + + outline := ' '; + for j := start to last do + begin + col := ColNoSelected[j-1]; + outline := outline + format('%8s',[ColLabels[col-1]]); + end; + lReport.Add(outline); + + outline := ' '; + for j := start to last do + begin + value := format('%8.4f',[scorearray[i-1,j-1]]); + outline := outline + value; + end; + lReport.Add(outline); + if (last = No_Objects) then + done := true + else begin + start := last; + last := start + 10; + end; + outline := ''; + end; // while end + lReport.Add(''); + end; // next i + + lReport.Add(''); + lReport.Add('Sum of Ranks for Each Object Judged'); + done := false; + start := 1; + last := 10; + while (not done) do + begin + if (last > No_Objects) then last := No_Objects; + lReport.Add(' Objects'); + outline := ' '; + for j := start to last do + begin + col := ColNoSelected[j-1]; + value := Format('%8s', [ColLabels[col-1]]); + outline := outline + value; + end; + lReport.Add(outline); + outline := ' '; + for j := start to last do + begin + value := Format('%8.4f',[ObjRankSums[j-1]]); + outline := outline + value; + end; + lReport.Add(outline); + lReport.Add(''); + if (last = No_Objects) then + done := true + else begin + start := last; + last := start + 10; + end; + end; + lReport.Add('Coefficient of concordance: %10.3f', [Concordance]); + lReport.Add('Average Spearman Rank Correlation: %10.3f', [AvgRankCorr]); + lReport.Add('Chi-Square Statistic: %10.3f', [ChiSquare]); + lReport.Add('Probability of a larger Chi-Square: %11.4f',[Probability]); + if (No_Objects < 7) then + lReport.Add('Warning - Above Chi-Square is very approximate with 7 or fewer variables!'); + + DisplayReport(lReport); + + finally + lReport.Free; + ColNoSelected := nil; + ColLabels := nil; + ObjRankSums := nil; + temprank := nil; + tempindex := nil; + scorearray := nil; + end; +end; + +procedure TConcordFrm.InBtnClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + SelList.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TConcordFrm.OutBtnClick(Sender: TObject); +var + index: integer; +begin + index := SelList.ItemIndex; + if (index > -1) then + begin + VarList.Items.Add(SelList.Items[index]); + SelList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TConcordFrm.UpdateBtnStates; +var + lSelected: Boolean; + i: Integer; +begin + lSelected := false; + for i := 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + InBtn.Enabled := lSelected; + + lSelected := false; + for i := 0 to SelList.Items.Count-1 do + if SelList.Selected[i] then + begin + lSelected := true; + break; + end; + OutBtn.Enabled := lSelected; + AllBtn.Enabled := VarList.Count > 0; +end; + +procedure TConcordFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I concordanceunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/exactunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/exactunit.lfm new file mode 100644 index 000000000..6a9a970af --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/exactunit.lfm @@ -0,0 +1,483 @@ +object FisherFrm: TFisherFrm + Left = 535 + Height = 472 + Top = 234 + Width = 672 + Caption = 'Fisher''s Exact Test for a 2 by 2 Table' + ClientHeight = 472 + ClientWidth = 672 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + LCLVersion = '2.1.0.0' + object InputGrp: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 114 + Top = 8 + Width = 425 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Input Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 94 + ClientWidth = 421 + Items.Strings = ( + 'Count cases classified by row and column vectors in the data grid.' + 'Use frequencies recorded in the data grid for row and column variables.' + 'Use proportions recorded in the data grid for row and column variables.' + 'Enter frequencies on this form.' + ) + OnClick = InputGrpClick + TabOrder = 0 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 455 + Height = 25 + Top = 439 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 521 + Height = 25 + Top = 439 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 605 + Height = 25 + Top = 439 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 5 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 423 + Width = 672 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel2: TPanel + AnchorSideLeft.Control = InputGrp + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = InputGrp + Left = 449 + Height = 77 + Top = 32 + Width = 206 + Alignment = taRightJustify + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 24 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 8 + ChildSizing.VerticalSpacing = 8 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 3 + ClientHeight = 77 + ClientWidth = 206 + TabOrder = 1 + object Label5: TLabel + Left = 0 + Height = 15 + Top = 0 + Width = 30 + Caption = ' ' + ParentColor = False + end + object Label6: TLabel + Left = 38 + Height = 15 + Top = 0 + Width = 80 + Alignment = taCenter + Caption = 'Row 1' + ParentColor = False + end + object Label7: TLabel + Left = 126 + Height = 15 + Top = 0 + Width = 80 + Alignment = taCenter + Caption = 'Row 2' + ParentColor = False + end + object Label8: TLabel + Left = 0 + Height = 23 + Top = 23 + Width = 30 + Caption = 'Col. 1' + Layout = tlCenter + ParentColor = False + end + object RC11Edit: TEdit + Left = 38 + Height = 23 + Top = 23 + Width = 80 + Alignment = taRightJustify + OnKeyPress = RC11EditKeyPress + TabOrder = 0 + Text = 'RC11Edit' + end + object RC12Edit: TEdit + Left = 126 + Height = 23 + Top = 23 + Width = 80 + Alignment = taRightJustify + OnKeyPress = RC12EditKeyPress + TabOrder = 1 + Text = 'RC12Edit' + end + object Label9: TLabel + Left = 0 + Height = 23 + Top = 54 + Width = 30 + Caption = 'Col. 2' + Layout = tlCenter + ParentColor = False + end + object RC21Edit: TEdit + Left = 38 + Height = 23 + Top = 54 + Width = 80 + Alignment = taRightJustify + OnKeyPress = RC21EditKeyPress + TabOrder = 2 + Text = 'RC21Edit' + end + object RC22Edit: TEdit + Left = 126 + Height = 23 + Top = 54 + Width = 80 + Alignment = taRightJustify + OnKeyPress = RC22EditKeyPress + TabOrder = 3 + Text = 'RC22Edit' + end + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = InputGrp + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 285 + Top = 138 + Width = 656 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 285 + ClientWidth = 656 + TabOrder = 2 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Variables Available' + ParentColor = False + end + object RowLabel: TLabel + AnchorSideLeft.Control = RowEdit + AnchorSideBottom.Control = RowEdit + Left = 350 + Height = 15 + Top = 25 + Width = 67 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Row Variable' + ParentColor = False + end + object ColLabel: TLabel + AnchorSideLeft.Control = ColEdit + AnchorSideBottom.Control = ColEdit + Left = 350 + Height = 15 + Top = 109 + Width = 87 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Column Variable' + ParentColor = False + end + object DepLabel: TLabel + AnchorSideLeft.Control = DepEdit + AnchorSideBottom.Control = DepEdit + Left = 350 + Height = 15 + Top = 193 + Width = 99 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Variable to Analyze' + ParentColor = False + end + object NCasesLabel: TLabel + AnchorSideTop.Control = NCasesEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NCasesEdit + Left = 494 + Height = 15 + Top = 257 + Width = 97 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Total No. of Cases:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = RowIn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 268 + Top = 17 + Width = 306 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 0 + end + object RowIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 314 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = RowInClick + Spacing = 0 + TabOrder = 1 + end + object RowEdit: TEdit + AnchorSideLeft.Control = RowIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = RowOut + AnchorSideBottom.Side = asrBottom + Left = 350 + Height = 23 + Top = 42 + Width = 298 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 2 + Text = 'RowEdit' + end + object ColEdit: TEdit + AnchorSideLeft.Control = ColIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ColOut + AnchorSideBottom.Side = asrBottom + Left = 350 + Height = 23 + Top = 126 + Width = 298 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'ColEdit' + end + object DepEdit: TEdit + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOut + AnchorSideBottom.Side = asrBottom + Left = 350 + Height = 23 + Top = 210 + Width = 298 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 4 + Text = 'DepEdit' + end + object NCasesEdit: TEdit + AnchorSideTop.Control = DepOut + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 599 + Height = 23 + Top = 253 + Width = 49 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 5 + Text = 'NCasesEdit' + end + object RowOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = RowIn + AnchorSideTop.Side = asrBottom + Left = 314 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = RowOutClick + Spacing = 0 + TabOrder = 6 + end + object ColIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = RowOut + AnchorSideTop.Side = asrBottom + Left = 314 + Height = 28 + Top = 101 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ColInClick + Spacing = 0 + TabOrder = 7 + end + object ColOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ColIn + AnchorSideTop.Side = asrBottom + Left = 314 + Height = 28 + Top = 133 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ColOutClick + Spacing = 0 + TabOrder = 8 + end + object DepIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ColOut + AnchorSideTop.Side = asrBottom + Left = 314 + Height = 28 + Top = 185 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInClick + Spacing = 0 + TabOrder = 9 + end + object DepOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepIn + AnchorSideTop.Side = asrBottom + Left = 314 + Height = 28 + Top = 217 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutClick + Spacing = 0 + TabOrder = 10 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/exactunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/exactunit.pas new file mode 100644 index 000000000..389e14799 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/exactunit.pas @@ -0,0 +1,542 @@ +unit ExactUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, Buttons, MainUnit, OutPutUnit, FunctionsLib, + Globals, DataProcs, Math; + +type + + { TFisherFrm } + + TFisherFrm = class(TForm) + Bevel1: TBevel; + Label5: TLabel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + RC11Edit: TEdit; + RC12Edit: TEdit; + RC21Edit: TEdit; + RC22Edit: TEdit; + Label6: TLabel; + Label7: TLabel; + Label8: TLabel; + Label9: TLabel; + NCasesEdit: TEdit; + NCasesLabel: TLabel; + Panel2: TPanel; + RowIn: TBitBtn; + RowOut: TBitBtn; + ColIn: TBitBtn; + ColOut: TBitBtn; + DepIn: TBitBtn; + DepOut: TBitBtn; + ColEdit: TEdit; + DepEdit: TEdit; + RowEdit: TEdit; + InputGrp: TRadioGroup; + Label1: TLabel; + RowLabel: TLabel; + ColLabel: TLabel; + DepLabel: TLabel; + VarList: TListBox; + Panel1: TPanel; + procedure ColInClick(Sender: TObject); + procedure ColOutClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure DepInClick(Sender: TObject); + procedure DepOutClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure InputGrpClick(Sender: TObject); + procedure RC11EditKeyPress(Sender: TObject; var Key: char); + procedure RC12EditKeyPress(Sender: TObject; var Key: char); + procedure RC21EditKeyPress(Sender: TObject; var Key: char); + procedure RC22EditKeyPress(Sender: TObject; var Key: char); + procedure ResetBtnClick(Sender: TObject); + procedure RowInClick(Sender: TObject); + procedure RowOutClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure PrintFisherTable(AList: TStrings; A, B, C, D: integer; P, SumP: double); + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + FisherFrm: TFisherFrm; + +implementation + +{ TFisherFrm } + +procedure TFisherFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + RowEdit.Text := ''; + ColEdit.Text := ''; + DepEdit.Text := ''; + DepEdit.Visible := false; + DepIn.Visible := false; + DepOut.Visible := false; + NCasesLabel.Visible := false; + DepLabel.Visible := false; + NCasesEdit.Text := ''; + NCasesEdit.Visible := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + Panel1.Visible := false; + Panel2.Visible := false; + RC11Edit.Text := ''; + RC12Edit.Text := ''; + RC21Edit.Text := ''; + RC22Edit.Text := ''; + UpdateBtnStates; +end; + +procedure TFisherFrm.RowInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (RowEdit.Text = '') then + begin + RowEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TFisherFrm.RowOutClick(Sender: TObject); +begin + if RowEdit.Text <> '' then + begin + VarList.Items.Add(RowEdit.Text); + RowEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TFisherFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TFisherFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TFisherFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TFisherFrm.ColInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (ColEdit.Text = '') then + begin + ColEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TFisherFrm.ColOutClick(Sender: TObject); +begin + if ColEdit.Text <> '' then + begin + VarList.Items.Add(ColEdit.Text); + ColEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TFisherFrm.ComputeBtnClick(Sender: TObject); +var + i, j, row, col, caserow, casecol, A, B, C, D, Largest: integer; + N, APlusB, APlusC, BPlusD, CPlusD, NoSelected, dep: integer; + FirstP, p, SumProb, Tocher, Alpha, X: double; + obs: array[1..2, 1..2] of integer; + ColNoSelected: IntDyneVec; + done, ok: boolean; + response: string; + lReport: TStrings; +begin + Randomize; // initialize random number generator + row := 0; + col := 0; + dep := 0; + + // get column no.s of row and col variables + if InputGrp.ItemIndex <> 3 then + begin + for i := 1 to NoVariables do + begin + if RowEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then row := i; + if ColEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then col := i; + if InputGrp.ItemIndex = 2 then + begin + if DepEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then dep := i; + end; + end; + end; + + SetLength(ColNoSelected,3); + ColNoSelected[0] := row; + ColNoSelected[1] := col; + if InputGrp.ItemIndex = 2 then + begin + ColNoSelected[2] := dep; + NoSelected := 3; + end else + NoSelected := 2; + + //initialize observed matrix + for i := 1 to 2 do + for j := 1 to 2 do obs[i,j] := 0; + + if InputGrp.ItemIndex = 3 then // get freq. from form + begin + if (RC11Edit.Text = '') or not TryStrToInt(RC11Edit.Text, obs[1, 1]) then + begin + RC11Edit.SetFocus; + MessageDlg('No valid input.', mtError, [mbOK], 0); + exit; + end; + if (RC12Edit.Text = '') or not TryStrToInt(RC12Edit.Text, obs[1, 2]) then + begin + RC12Edit.SetFocus; + MessageDlg('No valid input', mtError, [mbOK], 0); + exit; + end; + if (RC21Edit.Text = '') or not TryStrToInt(RC21Edit.Text, obs[2, 1]) then + begin + RC21Edit.SetFocus; + MessageDlg('No valid input.', mtError, [mbOK], 0); + exit; + end; + if (RC22Edit.Text = '') or not TryStrToInt(RC22Edit.Text, obs[2, 2]) then + begin + RC22Edit.SetFocus; + MessageDlg('No valid input', mtError, [mbOK], 0); + exit; + end; + end; + + if InputGrp.ItemIndex = 0 then // count no. in row/col combinations + begin + for j := 1 to NoCases do + begin + if (not GoodRecord(j,NoSelected,ColNoSelected)) then continue; + caserow := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[row,j]))); + casecol := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,j]))); + if (caserow > 2) or (caserow < 1) then + begin + MessageDlg('Row < 1 or > 2 found. Case ignored.', mtInformation, [mbOK], 0); + continue; + end; + if (casecol > 2) or (casecol < 1) then + begin + MessageDlg('Column < 1 or > 2 found. Case ignored.', mtInformation, [mbOK], 0); + continue; + end; + obs[caserow, casecol] := obs[caserow, casecol] + 1; + end; + end; + + if (InputGrp.ItemIndex = 1) or (InputGrp.ItemIndex = 2) then // Grid has frequencies for row/col + begin + for j := 1 to NoCases do + begin + if (not GoodRecord(j,NoSelected,ColNoSelected)) then continue; + caserow := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[row,j]))); + casecol := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,j]))); + if (caserow > 2) or (caserow < 1) then + begin + MessageDlg('Row < 1 or > 2 found. Case ignored.', mtInformation, [mbOk], 0); + continue; + end; + if (casecol > 2) or (casecol < 1) then + begin + MessageDlg('Column < 1 or > 2 found. Case ignored.', mtError, [mbOK], 0); + continue; + end; + obs[caserow, casecol] := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[dep,j]))); + if InputGrp.ItemIndex = 2 then + obs[caserow,casecol] := obs[caserow,casecol] * StrToInt(NCasesEdit.Text); + end; + end; + + //Find smallest value + A := obs[1, 1]; + B := obs[1, 2]; + C := obs[2, 1]; + D := obs[2, 2]; + APlusB := A + B; + CPlusD := C + D; + BPlusD := B + D; + APlusC := A + C; + N := A + B + C + D; + Largest := 1; + if (B > A) then largest := 2; + if ((B > A) and (B > C) and (B > D)) then Largest := 2; + if ((C > A) and (C > B) and (C > D)) then Largest := 3; + if ((D > A) and (D > B) and (D > C)) then Largest := 4; + + // Ready for output + lReport := TStringList.Create; + try + lReport.Add('FISHER EXACT PROBABILITY TEST'); + lReport.Add(''); + + //Get first probability + FirstP := combos(A, APlusC) * combos(B, BPlusD) / combos(APlusB, N); + SumProb := FirstP; + PrintFisherTable(lReport, A, B, C, D, FirstP, SumProb); + lReport.Add(''); + + //Get more extreme probabilities + done := false; + while (not done) do + begin + case Largest of + 1: begin// top row, first col + if (A = APlusB) then + done := true + else + begin + inc(A); + dec(B); + dec(C); + inc(D); + end; + end; + 2: begin// top row, second column + if (B = APlusB) then + done := true + else + begin + dec(A); + inc(B); + inc(C); + dec(D); + end; + end; + 3: begin // second row, first column + if (C = CPlusD) then + done := true + else + begin + dec(A); + inc(B); + inc(C); + dec(D); + end; + end; + 4: begin // second row, second column + if (D = CPlusD) then + done := true + else + begin + inc(A); + dec(B); + dec(C); + inc(D); + end; + end; + end; // end case + + if (not done) then + begin + p := combos(A, APlusC) * combos(b, BPlusD) / combos(APlusB, N); + SumProb := SumProb + p; + PrintFisherTable(lReport, A, B, C, D, p, SumProb); + lReport.Add(''); + end; + end; + + //Tocher's modification + repeat + response := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL); + ok := InputQuery('Alpha', 'Enter your Alpha level (Type I Error rate): ', response); + if not ok then + exit; + if TryStrToFloat(response, Alpha) then + break + else + MessageDlg('Not a valid number.', mtError, [mbOk], 0); + until false; + + if ((SumProb - FirstP) > Alpha) then //Extreme values > alpha - accept null hypothesis + lReport.Add('Null hypothesis accepted.') + else + begin//Extreme values significant - is total probability significant? + if (SumProb >= Alpha) then //No, so apply Tocher's rule + begin + Tocher := ( Alpha - (SumProb - FirstP)) / FirstP; + X := random(1000) / 1000.0; //Select a random value between 0 and num - 1 + lReport.Add('Tocher ratio computed: %5.3f', [Tocher]); + if (X < Tocher) then //Call it significant + begin + lReport.Add('A random value of %5.3f selected was less than the Tocher value.', [X]); + lReport.Add('Conclusion: Reject the null Hypothesis'); + end else + begin //Call it non-significant + lReport.Add('A random value of %5.3f selected was greater than the Tocher value.', [X]); + lReport.Add('Conclusion: Accept the null Hypothesis'); + end; + end else + begin //Total probability < alpha - reject null + lReport.Add('Probability less than alpha - reject null hypothesis.'); + end; // end if-else + end; // end if-else + + OutputFrm.Clear; + OutputFrm.AddLines(lReport); + OutputFrm.ShowModal; + finally + lReport.Free; + end; +end; + +procedure TFisherFrm.DepInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepEdit.Text = '') then + begin + DepEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TFisherFrm.DepOutClick(Sender: TObject); +begin + if DepEdit.Text <> '' then + begin + VarList.Items.Add(DepEdit.Text); + DepEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TFisherFrm.InputGrpClick(Sender: TObject); +begin + if InputGrp.ItemIndex = 3 then + begin + Panel2.Visible := true; + Panel1.Visible := false; + RC11Edit.SetFocus; + end else + begin + Panel1.Visible := true; + Panel2.Visible := false; + ColIn.Enabled := true; + ColOut.Enabled := false; + if InputGrp.ItemIndex = 2 then + begin + NCasesLabel.Visible := true; + NCasesEdit.Visible := true; + end + else begin + NCasesLabel.Visible := false; + NCasesEdit.Visible := false; + end; + if InputGrp.ItemIndex = 0 then + begin + DepLabel.Visible := false; + DepEdit.Visible := false; + DepIn.Visible := false; + DepOut.Visible := false; + end + else begin // InputGrp = 1 + DepLabel.Visible := true; + DepEdit.Visible := true; + DepIn.Visible := true; + DepOut.Visible := true; + DepIn.Enabled := true; + DepOut.Enabled := false; + end; + end; +end; + +procedure TFisherFrm.RC11EditKeyPress(Sender: TObject; var Key: char); +begin + if Key = #13 then RC12Edit.SetFocus; +end; + +procedure TFisherFrm.RC12EditKeyPress(Sender: TObject; var Key: char); +begin + if Key = #13 then RC21Edit.SetFocus; +end; + +procedure TFisherFrm.RC21EditKeyPress(Sender: TObject; var Key: char); +begin + if Key = #13 then RC22Edit.SetFocus; +end; + +procedure TFisherFrm.RC22EditKeyPress(Sender: TObject; var Key: char); +begin + if Key = #13 then ComputeBtn.SetFocus; +end; + +procedure TFisherFrm.PrintFisherTable(AList: TStrings; + A, B, C, D: integer; P, SumP: double); +begin + AList.Add('Contingency Table for Fisher Exact Test'); + AList.Add(' Column'); + AList.Add('Row 1 2'); + AList.Add(' 1 %10d %10d', [A, B]); + AList.Add(' 2 %10d %10d', [C, D]); + AList.Add(''); + AList.Add('Probability = %6.4f', [P]); + AList.Add('Cumulative Probability = %6.4f', [SumP]); + AList.Add(''); +end; + +procedure TFisherFrm.UpdateBtnStates; +begin + RowIn.Enabled := VarList.ItemIndex > -1; + ColIn.Enabled := VarList.ItemIndex > -1; + DepIn.Enabled := VarList.ItemIndex > -1; + RowOut.Enabled := RowEdit.Text <> ''; + ColOut.Enabled := ColEdit.Text <> ''; + DepOut.Enabled := DepEdit.Text <> ''; +end; + +initialization + {$I exactunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/friedmanunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/friedmanunit.lfm new file mode 100644 index 000000000..7dcb83d34 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/friedmanunit.lfm @@ -0,0 +1,270 @@ +object FriedmanFrm: TFriedmanFrm + Left = 540 + Height = 330 + Top = 186 + Width = 418 + AutoSize = True + Caption = 'The Friedman Two Way ANOVA on Ranks' + ClientHeight = 330 + ClientWidth = 418 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 209 + Height = 25 + Top = 297 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 2 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 271 + Height = 25 + Top = 297 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 3 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 355 + Height = 25 + Top = 297 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 4 + end + object HelpBtn: TButton + Tag = 124 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 150 + Height = 25 + Top = 297 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 1 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 281 + Width = 418 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 273 + Top = 8 + Width = 402 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 273 + ClientWidth = 402 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 97 + BorderSpacing.Right = 8 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = GrpVar + AnchorSideBottom.Control = GrpVar + Left = 223 + Height = 15 + Top = 32 + Width = 77 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Group Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = TreatVars + AnchorSideTop.Control = TrtIn + AnchorSideBottom.Control = TreatVars + Left = 223 + Height = 15 + Top = 116 + Width = 102 + BorderSpacing.Bottom = 2 + Caption = 'Treatment Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GrpIn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 258 + Top = 15 + Width = 179 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Right = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object GrpIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + Left = 187 + Height = 28 + Top = 22 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = GrpInClick + Spacing = 0 + TabOrder = 1 + end + object GrpOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + Left = 187 + Height = 28 + Top = 56 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = GrpOutClick + Spacing = 0 + TabOrder = 2 + end + object TrtIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = GrpOut + AnchorSideTop.Side = asrBottom + Left = 187 + Height = 28 + Top = 116 + Width = 28 + BorderSpacing.Top = 32 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = TrtInClick + Spacing = 0 + TabOrder = 4 + end + object TrtOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = TrtIn + AnchorSideTop.Side = asrBottom + Left = 187 + Height = 28 + Top = 148 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = TrtOutClick + Spacing = 0 + TabOrder = 5 + end + object GrpVar: TEdit + AnchorSideLeft.Control = GrpIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GrpOut + AnchorSideBottom.Side = asrBottom + Left = 223 + Height = 23 + Top = 49 + Width = 179 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'GrpVar' + end + object TreatVars: TListBox + AnchorSideLeft.Control = GrpOut + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 223 + Height = 140 + Top = 133 + Width = 179 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + ItemHeight = 0 + MultiSelect = True + OnSelectionChange = VarListSelectionChange + TabOrder = 6 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/friedmanunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/friedmanunit.pas new file mode 100644 index 000000000..a931f5750 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/friedmanunit.pas @@ -0,0 +1,434 @@ +unit FriedmanUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, OutPutUnit, DataProcs, FunctionsLib, MatrixLib, + ContextHelpUnit; + +type + + { TFriedmanFrm } + + TFriedmanFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + GrpVar: TEdit; + GrpIn: TBitBtn; + GrpOut: TBitBtn; + Label2: TLabel; + Label3: TLabel; + TreatVars: TListBox; + TrtIn: TBitBtn; + TrtOut: TBitBtn; + Label1: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure GrpInClick(Sender: TObject); + procedure GrpOutClick(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure TrtInClick(Sender: TObject); + procedure TrtOutClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutosized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + FriedmanFrm: TFriedmanFrm; + +implementation + +uses + Math; + +{ TFriedmanFrm } + +procedure TFriedmanFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Items.Clear; + TreatVars.Items.Clear; + GrpVar.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TFriedmanFrm.TrtInClick(Sender: TObject); +var + i: integer; +begin + i := 0; + while i < VarList.Items.Count do + begin + if VarList.Selected[i] then + begin + TreatVars.Items.Add(VarList.Items[i]); + VarList.Items.Delete(i); + i := 0; + end + else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TFriedmanFrm.TrtOutClick(Sender: TObject); +var + i: Integer; +begin + i := 0; + while i < TreatVars.Items.Count do + begin + if TreatVars.Selected[i] then + begin + VarList.Items.Add(TreatVars.Items[i]); + TreatVars.Items.Delete(i); + i := 0; + end else + inc(i); + end; + UpdateBtnStates; +end; + +procedure TFriedmanFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TFriedmanFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TFriedmanFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TFriedmanFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TFriedmanFrm.ComputeBtnClick(Sender: TObject); +Var + i, j, k, L, col, itemp, GrpCol, mingrp, maxgrp : integer; + tiestart, tieend, NoSelected, NCases, group, nogrps : integer; + s, t, TotRanks, chisqr, probchi, score : double; + X, ColRanks : DblDyneVec; + Ranks, means : DblDyneMat; + RowLabels, ColLabels : StrDyneVec; + index : IntDyneVec; + GrpNo : IntdyneMat; + cellstring, outline: string; + title : string; + ties : boolean; + ColNoSelected : IntDyneVec; + lReport: TStrings; +begin + if GrpVar.Text = '' then begin + MessageDlg('Group variable not selected.', mtError, [mbOK], 0); + exit; + end; + + if TreatVars.Items.Count = 0 then + begin + MessageDlg('No treatment variable selected.', mtError, [mbOK], 0); + exit; + end; + + k := TreatVars.Items.Count; + NoSelected := k + 1; + SetLength(ColNoSelected,NoVariables); + SetLength(ColLabels,NoVariables); + + // get group variable and treatment variables + GrpCol := 0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = GrpVar.Text then + begin + ColNoSelected[0] := i; + GrpCol := i; + end; + for j := 1 to k do + begin + if cellstring = TreatVars.Items.Strings[j-1] then + begin + ColNoSelected[j] := i; + ColLabels[j-1] := cellstring; + end; + end; + end; + + // get minimum and maximum group codes + NCases := 0; + mingrp := 10000; + maxgrp := -10000; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + NCases := NCases + 1; + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpCol,i]))); + if group > maxgrp then maxgrp := group; + if group < mingrp then mingrp := group; + end; + nogrps := maxgrp - mingrp + 1; + + // Initialize arrays + SetLength(RowLabels,nogrps); + SetLength(index,k); + SetLength(GrpNo,nogrps,k); + SetLength(Ranks,nogrps,k); + SetLength(means,nogrps,k); + SetLength(X,k); + SetLength(ColRanks,k); + for j := 0 to k-1 do + begin + for i := 0 to nogrps-1 do + begin + means[i,j] := 0.0; + Ranks[i,j] := 0.0; + GrpNo[i,j] := 0; + end; + ColRanks[j] := 0.0; + X[j] := 0.0; + index[j] := j+1; + end; + + // Initialize labels + for i := 1 to nogrps do + begin + cellstring := format('Group %d',[mingrp + i - 1]); + RowLabels[i-1] := cellstring; + end; + + // Setup for printing results + lReport := TStringList.Create; + try + lReport.Add('FRIEDMAN TWO-WAY ANOVA ON RANKS'); + lReport.Add('See pages 166-173 in S. Siegel''s Nonparametric Statistics'); + lReport.Add('for the Behavioral Sciences, McGraw-Hill Book Co., New York, 1956'); + lReport.Add(''); + + // Obtain mean score for each cell + for i := 1 to NoCases do + begin + if ( not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpCol,i]))); + group := group - mingrp + 1; + for j := 1 to k do // treatment values + begin + col := ColNoSelected[j]; + score := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); + means[group-1,j-1] := means[group-1,j-1] + score; + GrpNo[group-1,j-1] := GrpNo[group-1,j-1] + 1; + end; + end; + for i := 1 to nogrps do + for j := 1 to k do + means[i-1,j-1] := means[i-1,j-1] / GrpNo[i-1,j-1]; + + // Print means and group size arrays + title := 'Treatment means - values to be ranked.'; + MatPrint(means,nogrps,k,title,RowLabels,ColLabels,NCases, lReport); + title := 'Number in each group''s treatment.'; + IntArrayPrint(GrpNo,nogrps,k,'GROUP',RowLabels,ColLabels,title, lReport); + + // Gather row data in X array and rank within rows + for i := 0 to nogrps-1 do + begin + for j := 0 to k-1 do + begin + X[j] := means[i,j]; + index[j] := j+1; + end; + + //rank scores in this row i + for j := 1 to k - 1 do + begin + for L := j + 1 to k do + begin + if (X[j-1] > X[L-1]) then + begin + t := X[j-1]; + X[j-1] := X[L-1]; + X[L-1] := t; + itemp := index[j-1]; + index[j-1] := index[L-1]; + index[L-1] := itemp; + end; + end; + end; + for j := 1 to k do + begin + Ranks[i,index[j-1]-1] := j; + end; + + //Check for tied ranks and use average if desired here + tiestart := 0; + tieend := 0; + ties := false; + j := 1; + while j < k do + begin + for L := j + 1 to k do + begin + if (means[i,j-1] = means[i,L-1]) then + begin + ties := true; + tiestart := j; + tieend := L; + end; + end; + if (ties = true) then + begin + s := 0.0; + for L := tiestart to tieend do s := s + Ranks[i,L-1]; + for L := tiestart to tieend do + Ranks[i,L-1] := s / (tieend - tiestart + 1); + j := tieend; + ties := false; + end; + j := j + 1; + end; // next j + end; // next group i + + //Get sum of ranks in columns + for i := 1 to nogrps do + for j := 1 to k do + ColRanks[j-1] := ColRanks[j-1] + Ranks[i-1,j-1]; + + //Calculate Statistics + TotRanks := 0; + for j := 1 to k do TotRanks := TotRanks + (ColRanks[j-1] * ColRanks[j-1]); + chisqr := TotRanks * 12.0 / (nogrps * k * (k + 1)); + chisqr := chisqr - (3 * nogrps * (k + 1)); + probchi := 1.0 - chisquaredprob(chisqr, k - 1); + + //Now, show results + title := 'Score Rankings Within Groups'; + MatPrint(Ranks,nogrps,k,title,RowLabels,ColLabels,NCases, lReport); + title := 'TOTAL RANKS'; + DynVectorPrint(ColRanks,k,title,ColLabels,NCases, lReport); + lReport.Add(''); + lReport.Add('Chi-square with %d D.F.: %.3f with probability %.4f', [k-1, chisqr, probchi]); + if ((k < 5) and (nogrps < 10)) then + begin + lReport.Add('Chi-square too approximate-use exact table (TABLE N)'); + lReport.Add('page 280-281 in Siegel'); + end; + + DisplayReport(lReport); + + finally + lReport.Free; + ColRanks := nil; + X := nil; + means := nil; + Ranks := nil; + GrpNo := nil; + index := nil; + RowLabels := nil; + ColLabels := nil; + ColNoSelected := nil; + end; +end; + +procedure TFriedmanFrm.GrpInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (GrpVar.Text = '') then + begin + GrpVar.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TFriedmanFrm.GrpOutClick(Sender: TObject); +begin + if GrpVar.Text <> '' then + begin + VarList.Items.Add(GrpVar.Text); + GrpVar.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TFriedmanFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TFriedmanFrm.UpdateBtnStates; +var + i: Integer; + lSelected: Boolean; +begin + lSelected := false; + for i:= 0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + GrpIn.Enabled := lSelected and (GrpVar.Text = ''); + TrtIn.Enabled := lSelected; + + GrpOut.Enabled := GrpVar.Text <> ''; + + lSelected := false; + for i := 0 to TreatVars.Items.Count-1 do + if TreatVars.Selected[i] then + begin + lSelected := true; + break; + end; + TrtOut.Enabled := lSelected; +end; + + +initialization + {$I friedmanunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/genkappaunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/genkappaunit.lfm new file mode 100644 index 000000000..f82c27d24 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/genkappaunit.lfm @@ -0,0 +1,348 @@ +object GenKappaFrm: TGenKappaFrm + Left = 641 + Height = 356 + Top = 378 + Width = 468 + AutoSize = True + Caption = 'Generalized Kappa Coefficient' + ClientHeight = 356 + ClientWidth = 468 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 167 + Height = 25 + Top = 323 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 2 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 233 + Height = 25 + Top = 323 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 3 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 307 + Height = 25 + Top = 323 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 4 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 395 + Height = 25 + Top = 323 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 5 + end + object HelpBtn: TButton + Tag = 125 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 104 + Height = 25 + Top = 323 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 1 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ComputeBtn + Left = 0 + Height = 8 + Top = 307 + Width = 468 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 299 + Top = 8 + Width = 452 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 299 + ClientWidth = 452 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = CatEdit + AnchorSideBottom.Control = CatEdit + Left = 248 + Height = 15 + Top = 25 + Width = 117 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Category Code (1,2,...)' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ObjectEdit + AnchorSideBottom.Control = ObjectEdit + Left = 248 + Height = 15 + Top = 117 + Width = 144 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Object or Subject Classified' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = RaterEdit + AnchorSideBottom.Control = RaterEdit + Left = 248 + Height = 15 + Top = 209 + Width = 101 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Rater Codes (1,2,...)' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 49 + Caption = 'Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CatIn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 282 + Top = 17 + Width = 204 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 0 + end + object CatIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 212 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = CatInClick + Spacing = 0 + TabOrder = 1 + end + object CatOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = CatIn + AnchorSideTop.Side = asrBottom + Left = 212 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = CatOutClick + Spacing = 0 + TabOrder = 2 + end + object ObjIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = CatOut + AnchorSideTop.Side = asrBottom + Left = 212 + Height = 28 + Top = 109 + Width = 28 + BorderSpacing.Top = 32 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ObjInClick + Spacing = 0 + TabOrder = 4 + end + object ObjOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ObjIn + AnchorSideTop.Side = asrBottom + Left = 212 + Height = 28 + Top = 141 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ObjOutClick + Spacing = 0 + TabOrder = 5 + end + object RaterIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ObjOut + AnchorSideTop.Side = asrBottom + Left = 212 + Height = 28 + Top = 201 + Width = 28 + BorderSpacing.Top = 32 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = RaterInClick + Spacing = 0 + TabOrder = 7 + end + object RaterOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = RaterIn + AnchorSideTop.Side = asrBottom + Left = 212 + Height = 28 + Top = 233 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = RaterOutClick + Spacing = 0 + TabOrder = 8 + end + object CatEdit: TEdit + AnchorSideLeft.Control = CatIn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CatOut + AnchorSideBottom.Side = asrBottom + Left = 248 + Height = 23 + Top = 42 + Width = 204 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 3 + Text = 'CatEdit' + end + object ObjectEdit: TEdit + AnchorSideLeft.Control = ObjOut + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ObjOut + AnchorSideBottom.Side = asrBottom + Left = 248 + Height = 23 + Top = 134 + Width = 204 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 6 + Text = 'Edit1' + end + object RaterEdit: TEdit + AnchorSideLeft.Control = RaterOut + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = RaterIn + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = RaterOut + AnchorSideBottom.Side = asrBottom + Left = 248 + Height = 23 + Top = 226 + Width = 204 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 9 + Text = 'Edit1' + end + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/genkappaunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/genkappaunit.pas new file mode 100644 index 000000000..1ab970a8f --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/genkappaunit.pas @@ -0,0 +1,516 @@ +unit GenKappaUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, MainUnit, + Globals, OutputUnit, FunctionsLib, ContextHelpUnit; +type + + { TGenKappaFrm } + + TGenKappaFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Label4: TLabel; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + CatIn: TBitBtn; + CatOut: TBitBtn; + CatEdit: TEdit; + ObjectEdit: TEdit; + RaterEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + ObjIn: TBitBtn; + ObjOut: TBitBtn; + RaterIn: TBitBtn; + RaterOut: TBitBtn; + VarList: TListBox; + procedure CatInClick(Sender: TObject); + procedure CatOutClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ObjInClick(Sender: TObject); + procedure ObjOutClick(Sender: TObject); + procedure RaterInClick(Sender: TObject); + procedure RaterOutClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + NoCats : integer; + NoObjects : integer; + NoRaters : integer; + function compute_term1(R : IntDyneCube; i, j, k : integer) : double; + function compute_term2(R : IntDyneCube; i, j, l : integer) : double; + function compute_denom(R : IntDyneCube) : double; + function compute_partial_pchance(R : IntDyneCube; i, j : integer; + denom : double) : double; + function compute_partial_pobs(R : IntDyneCube; k, l : integer) : double; + function KappaVariance(R : IntDyneCube; n, m, K1 : integer) : double; + + public + { public declarations } + end; + +var + GenKappaFrm: TGenKappaFrm; + +implementation + +uses + Math; + +{ TGenKappaFrm } + +procedure TGenKappaFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + CatIn.Enabled := true; + CatOut.Enabled := false; + ObjIn.Enabled := true; + ObjOut.Enabled := false; + RaterIn.Enabled := true; + RaterOut.Enabled := false; + CatEdit.Text := ''; + ObjectEdit.Text := ''; + RaterEdit.Text := ''; + VarList.Clear; + for i := 0 to NoVariables - 1 do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i+1,0]); +end; + +procedure TGenKappaFrm.CatInClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + CatEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + CatIn.Enabled := false; + CatOut.Enabled := true; +end; + +procedure TGenKappaFrm.CatOutClick(Sender: TObject); +begin + VarList.Items.Add(CatEdit.Text); + CatEdit.Text := ''; + CatIn.Enabled := true; + CatOut.Enabled := false; +end; + +procedure TGenKappaFrm.ComputeBtnClick(Sender: TObject); +VAR + CatCol, ObjCol, RaterCol, frequency, i, j, k, l : integer; + value, rater, category, anobject: integer; +// int CatCol:=0, ObjCol:=0, RaterCol:=0; +// int value, rater, category, object; + R : IntDyneCube; +// int ***R; + pobs, pchance, kappa, num, denom, partial_pchance, a_priori : double; + average_frequency : DblDyneVec; + outline : array[0..131] of char; +// char outline[131], astring[21]; + z : double; + +begin + CatCol:=0; + ObjCol:=0; + RaterCol:=0; + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Generalized Kappa Coefficient Procedure'); + OutputFrm.RichEdit.Lines.Add('adapted from the program written by Giovanni Flammia'); + OutputFrm.RichEdit.Lines.Add('copywritten 1995, M.I.T. Lab. for Computer Science'); + OutputFrm.RichEdit.Lines.Add(''); + + // get columns for the variables + for i := 0 to NoVariables - 1 do + begin + if (OS3MainFrm.DataGrid.Cells[i+1,0] = CatEdit.Text) then CatCol := i+1; + if (OS3MainFrm.DataGrid.Cells[i+1,0] = RaterEdit.Text) then RaterCol := i+1; + if (OS3MainFrm.DataGrid.Cells[i+1,0] = ObjectEdit.Text) then ObjCol := i+1; + end; + if ((CatCol = 0) or (RaterCol = 0) or (ObjCol = 0)) then + begin + ShowMessage('ERROR! One or more variables not defined.'); + exit; + end; + // get max no of codes for objects, raters, categories + NoCats := 0; + NoObjects := 0; + NoRaters := 0; + for i := 0 to NoCases - 1 do + begin + value := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[CatCol,i+1])); +// result := GetValue(i+1,CatCol,intvalue,dblvalue,strvalue); +// if (result :=:= 1) value := 0; +// else value := intvalue; + if (value > NoCats) then NoCats := value; + value := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[ObjCol,i+1])); +// result := GetValue(i+1,ObjCol,intvalue,dblvalue,strvalue); +// if (result :=:= 1) value := 0; +// else value := intvalue; + if (value > NoObjects) then NoObjects := value; + value := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[RaterCol,i+1])); +// result := GetValue(i+1,RaterCol,intvalue,dblvalue,strvalue); +// if (result :=:= 1) value := 0; +// else value := intvalue; + if (value > NoRaters) then NoRaters := value; + end; + + outline := format('%d Raters using %d Categories to rate %d Objects', + [NoRaters, NoCats, NoObjects]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + // get memory for R and set to zero + SetLength(R,NoRaters+1,NoCats+1,NoObjects+1); + for i := 0 to NoRaters - 1 do + begin + for k := 0 to NoCats - 1 do + begin + for l := 0 to NoObjects - 1 do + begin + R[i,k,l] := 0; + end; + end; + end; + + // get memory for average_frequency + SetLength(average_frequency,NoCats+1); + for k := 0 to NoCats - 1 do average_frequency[k] := 0.0; + + // read data and store in R + for i := 0 to NoCases - 1 do + begin + rater := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[RaterCol,i+1])); + anobject := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[ObjCol,i+1])); + category := StrToInt(Trim(OS3MainFrm.DataGrid.Cells[CatCol,i+1])); + R[rater-1,category-1,anobject-1] := 1; + end; + + //compute chance probability of agreement pchance for all raters + pchance := 0.0; + denom := compute_denom(R); + for i := 0 to NoRaters - 1 do + begin + for j := 0 to NoRaters - 1 do + begin + if (i <> j) then + begin + partial_pchance := compute_partial_pchance(R,i,j,denom); + pchance := pchance + partial_pchance; + end; + end; + for k := 0 to NoCats - 1 do + begin + frequency := 0; + for l := 0 to NoObjects - 1 do + begin + frequency := frequency + R[i,k,l]; + end; + a_priori := frequency / NoObjects; + outline := format('Frequency[%d,%d] := %f',[i+1,k+1,a_priori]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + + for k := 0 to NoCats - 1 do + begin + for l := 0 to NoObjects - 1 do + begin + for i := 0 to NoRaters - 1 do + begin + average_frequency[k] := average_frequency[k] + R[i,k,l]; + end; + end; + end; + + for k := 0 to NoCats - 1 do + begin + average_frequency[k] := average_frequency[k] / (NoObjects * NoRaters); + outline := format('Average_Frequency[%d] := %f',[k+1,average_frequency[k]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := format('PChance := %f',[pchance]); + OutputFrm.RichEdit.Lines.Add(outline); + + // compute observed probability of agreement among all raters + num := 0.0; + for k := 0 to NoCats - 1 do + begin + for l := 0 to NoObjects - 1 do + begin + num := num + compute_partial_pobs(R,k,l); + end; + end; + if (denom > 0.0) then pobs := num / denom + else pobs := 0.0; + outline := format('PObs := %f',[pobs]); + OutputFrm.RichEdit.Lines.Add(outline); + + kappa := (pobs - pchance) / (1.0 - pchance); + outline := format('Kappa := %f',[kappa]); + OutputFrm.RichEdit.Lines.Add(outline); + z := KappaVariance(R,NoObjects,NoRaters,NoCats); + if (z > 0.0) then z := kappa / sqrt(z); + outline := format('z for Kappa := %8.3f with probability > %8.3f',[z,1.0-probz(z)]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + + // clean up space allocated + average_frequency := nil; + R := nil; +end; + +procedure TGenKappaFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TGenKappaFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TGenKappaFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TGenKappaFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +function TGenKappaFrm.compute_term1(R : IntDyneCube; i, j, k : integer) : double; +VAR + kk : integer; // range over 0 .. num_categories-1 */ + l,ll : integer; // range over 0 .. num_points-1 */ + denom_i : integer; //:=0; + denom_j : integer; //:=0; + num_i : integer; //:=0; + num_j : integer; //:=0; + +begin + denom_i := 0; + denom_j := 0; + num_i := 0; + num_j := 0; + for kk := 0 to NoCats - 1 do + begin + for ll := 0 to NoObjects - 1 do + begin + denom_i := denom_i + R[i,kk,ll]; + denom_j := denom_j + R[j,kk,ll]; + end; + end; + + for l := 0 to NoObjects - 1 do + begin + num_i := num_i + R[i,k,l]; + num_j := num_j + R[j,k,l]; + end; + + result := ((num_i / denom_i) * (num_j / denom_j)); +end; + +function TGenKappaFrm.compute_term2(R : IntDyneCube; i, j, l : integer) : double; +VAR + sum_i, sum_j, k : integer; +begin + sum_i:=0; + sum_j:=0; + + for k := 0 to NoCats - 1 do + begin + sum_i := sum_i + R[i,k,l]; + sum_j := sum_j + R[j,k,l]; + end; + + result := (sum_i * sum_j ); +end; + +//--------------------------------------------------------------------------- + +function TGenKappaFrm.compute_denom(R : IntDyneCube) : double; +VAR + sum : IntDyneVec; + aresult : double; + i, k, l : integer; +begin + aresult := 0; + + SetLength(sum,NoObjects); // sum := (int *)calloc(num_points,sizeof(int)); + for l := 0 to NoObjects - 1 do + begin + sum[l] := 0; + for i := 0 to NoRaters - 1 do + begin + for k := 0 to NoCats - 1 do + begin + sum[l] := sum[l] + R[i,k,l]; + end; + end; + end; + for l := 0 to NoObjects - 1 do + begin + aresult := aresult + sum[l] * ( sum[l] - 1); + end; + sum := nil; + result := aresult; +end; + +function TGenKappaFrm.compute_partial_pchance(R : IntDyneCube; i, j : integer; + denom : double) : double; +VAR + term1, term2 : double; + k, l : integer; +begin + term1 := 0; + term2 := 0; + + for k := 0 to NoCats - 1 do + begin + term1 := term1 + compute_term1(R,i,j,k); + end; + + for l := 0 to NoObjects - 1 do + begin + term2 := term2 + compute_term2(R,i,j,l); + end; + if (denom > 0.0) then result := ( term1 * ( term2 / denom ) ) + else result := 0.0; +end; +//--------------------------------------------------------------------------- + +function TGenKappaFrm.compute_partial_pobs(R : IntDyneCube; k, l : integer) : double; +VAR + sum, i : integer; +begin + sum := 0; + + for i := 0 to NoRaters - 1 do + begin + sum := sum + R[i,k,l]; + end; + + result := (sum * (sum - 1)); +end; + +function TGenKappaFrm.KappaVariance(R : IntDyneCube; n, m, K1 : integer) : double; +VAR + xij, variance, term1, term2 : double; + i, j, k : integer; + pj : DblDyneVec; + +begin + // calculates the variance of Kappa + // R contains 1's or 0's for raters, categories and objects (row, col, slice) + // m is number of raters + // n is number of subjects + // K1 is the number of categories + + term1 := 0.0; + term2 := 0.0; + SetLength(pj,K1); + for j := 0 to K1 - 1 do pj[j] := 0.0; + + // get proportion of values in each category + for j := 0 to K1 - 1 do // accross categories + begin + xij := 0.0; + for i := 0 to m - 1 do // accross raters + begin + for k := 0 to n - 1 do // accross objects + begin + xij := xij + R[i,j,k]; + end; + end; + pj[j] := pj[j] + xij; + end; + for j := 0 to K1 - 1 do pj[j] := pj[j] / (n * m); + for j := 0 to K1 - 1 do + begin + term1 := term1 +(pj[j] * (1.0 - pj[j])); + term2 := term2 + (pj[j] * (1.0 - pj[j]) * (1.0 - 2.0 * pj[j])); + end; + term1 := term1 * term1; + if ((term1 > 0) and (term2 > 0)) then + variance := (2.0 / (n * m * (m-1) * term1)) * (term1 - term2) + else variance := 0.0; + pj := nil; + result := variance; +end; + +procedure TGenKappaFrm.ObjInClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + + ObjectEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + ObjIn.Enabled := false; + ObjOut.Enabled := true; +end; + +procedure TGenKappaFrm.ObjOutClick(Sender: TObject); +begin + VarList.Items.Add(ObjectEdit.Text); + ObjectEdit.Text := ''; + ObjIn.Enabled := true; + ObjOut.Enabled := false; +end; + +procedure TGenKappaFrm.RaterInClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + + RaterEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + RaterIn.Enabled := false; + RaterOut.Enabled := true; +end; + +procedure TGenKappaFrm.RaterOutClick(Sender: TObject); +begin + VarList.Items.Add(RaterEdit.Text); + RaterEdit.Text := ''; + RaterIn.Enabled := true; + RaterOut.Enabled := false; +end; + +initialization + {$I genkappaunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/kaplanmeierunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/kaplanmeierunit.lfm new file mode 100644 index 000000000..e77435515 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/kaplanmeierunit.lfm @@ -0,0 +1,368 @@ +object KaplanMeierFrm: TKaplanMeierFrm + Left = 849 + Height = 406 + Top = 368 + Width = 505 + AutoSize = True + Caption = 'Kaplan-Meier Survival Analysis' + ClientHeight = 406 + ClientWidth = 505 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 288 + Height = 25 + Top = 373 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 2 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 350 + Height = 25 + Top = 373 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 3 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 438 + Height = 25 + Top = 373 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 4 + end + object HelpBtn: TButton + Tag = 127 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 229 + Height = 25 + Top = 373 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 1 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 357 + Width = 505 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 349 + Top = 8 + Width = 489 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 349 + ClientWidth = 489 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = TimeEdit + AnchorSideBottom.Control = TimeEdit + Left = 266 + Height = 15 + Top = 25 + Width = 70 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Time Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = EventEdit + AnchorSideBottom.Control = EventEdit + Left = 266 + Height = 30 + Top = 108 + Width = 140 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Event vs Censored Variable'#13#10'(Event = 1, Censored = 2)' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = GroupEdit + AnchorSideBottom.Control = GroupEdit + Left = 266 + Height = 30 + Top = 194 + Width = 160 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Group Variable (if 2 groups)'#13#10'(Experimental = 1, Control =2)' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = TimeInBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 332 + Top = 17 + Width = 222 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object TimeInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 230 + Height = 28 + Top = 17 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = TimeInBtnClick + Spacing = 0 + TabOrder = 1 + end + object TimeOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = TimeInBtn + AnchorSideTop.Side = asrBottom + Left = 230 + Height = 28 + Top = 49 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = TimeOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object EventInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = TimeOutBtn + AnchorSideTop.Side = asrBottom + Left = 230 + Height = 28 + Top = 105 + Width = 28 + BorderSpacing.Top = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = EventInBtnClick + Spacing = 0 + TabOrder = 4 + end + object EventOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = EventInBtn + AnchorSideTop.Side = asrBottom + Left = 230 + Height = 28 + Top = 137 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = EventOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object GroupInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = EventOutBtn + AnchorSideTop.Side = asrBottom + Left = 230 + Height = 28 + Top = 189 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = GroupInBtnClick + Spacing = 0 + TabOrder = 7 + end + object GroupOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = GroupInBtn + AnchorSideTop.Side = asrBottom + Left = 230 + Height = 28 + Top = 221 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = GroupOutBtnClick + Spacing = 0 + TabOrder = 8 + end + object TimeEdit: TEdit + AnchorSideLeft.Control = TimeInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = TimeOutBtn + AnchorSideBottom.Side = asrBottom + Left = 266 + Height = 23 + Top = 42 + Width = 223 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 3 + Text = 'TimeEdit' + end + object EventEdit: TEdit + AnchorSideLeft.Control = EventInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = EventOutBtn + AnchorSideBottom.Side = asrBottom + Left = 266 + Height = 23 + Top = 140 + Width = 223 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + TabOrder = 6 + Text = 'EventEdit' + end + object GroupEdit: TEdit + AnchorSideLeft.Control = GroupInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupOutBtn + AnchorSideBottom.Side = asrBottom + Left = 266 + Height = 23 + Top = 226 + Width = 223 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + TabOrder = 9 + Text = 'GroupEdit' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = GroupOutBtn + AnchorSideTop.Control = GroupOutBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 230 + Height = 72 + Top = 273 + Width = 213 + AutoSize = True + BorderSpacing.Top = 24 + Caption = 'Options:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 209 + TabOrder = 10 + object PlotChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 185 + Caption = 'Graph Survival Probabilities (%)' + TabOrder = 0 + end + object PrintChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 185 + AutoSize = False + Caption = 'Show Computation Results' + TabOrder = 1 + end + end + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/kaplanmeierunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/kaplanmeierunit.pas new file mode 100644 index 000000000..1a8899ec4 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/kaplanmeierunit.pas @@ -0,0 +1,1151 @@ +unit KaplanMeierUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, Clipbrd, + MainUnit, Globals, FunctionsLib, OutputUnit, ContextHelpUnit; + +type + + { TKaplanMeierFrm } + + TKaplanMeierFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + PlotChk: TCheckBox; + PrintChk: TCheckBox; + GroupBox1: TGroupBox; + TimeInBtn: TBitBtn; + TimeOutBtn: TBitBtn; + EventInBtn: TBitBtn; + EventOutBtn: TBitBtn; + GroupInBtn: TBitBtn; + GroupOutBtn: TBitBtn; + TimeEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label5: TLabel; + EventEdit: TEdit; + GroupEdit: TEdit; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure EventInBtnClick(Sender: TObject); + procedure EventOutBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure GroupInBtnClick(Sender: TObject); + procedure GroupOutBtnClick(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure TimeInBtnClick(Sender: TObject); + procedure TimeOutBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure PlotXY(var Xpoints : IntDyneVec; + var Ypoints : DblDyneVec; + var Dropped : IntDyneVec; + var Dropped2 : IntDyneVec; + Xmax, Xmin, Ymax, Ymin : double; + N : integer; + XEdit : string; + YEdit : string; + curveno : integer); + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + KaplanMeierFrm: TKaplanMeierFrm; + +implementation + +uses + Math, BlankFrmUnit; + +{ TKaplanMeierFrm } + +procedure TKaplanMeierFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + TimeEdit.Text := ''; + EventEdit.Text := ''; + GroupEdit.Text := ''; + UpdateBtnStates; + PlotChk.Checked := false; + PrintChk.Checked := false; +end; + +procedure TKaplanMeierFrm.TimeInBtnClick(Sender: TObject); +var + i: integer; +begin + i := VarList.ItemIndex; + if (i > -1) and (TimeEdit.Text = '') then + begin + TimeEdit.Text := VarList.Items[i]; + VarList.Items.Delete(i); + end; + UpdateBtnStates; +end; + +procedure TKaplanMeierFrm.TimeOutBtnClick(Sender: TObject); +begin + if TimeEdit.Text <> '' then + begin + VarList.Items.Add(TimeEdit.Text); + TimeEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TKaplanMeierFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + Panel1.Constraints.MinWidth := 2 * GroupBox1.Width + VarList.BorderSpacing.Left; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TKaplanMeierFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if BlankFrm = nil then + Application.CreateForm(TBlankFrm, BlankFrm); +end; + +procedure TKaplanMeierFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TKaplanMeierFrm.GroupInBtnClick(Sender: TObject); +var + i: integer; +begin + i := VarList.ItemIndex; + if (i > -1) and (GroupEdit.Text = '') then + begin + GroupEdit.Text := VarList.Items[i]; + VarList.Items.Delete(i); + end; + UpdateBtnStates; +end; + +procedure TKaplanMeierFrm.GroupOutBtnClick(Sender: TObject); +begin + if GroupEdit.Text <> '' then + begin + VarList.Items.Add(GroupEdit.Text); + GroupEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TKaplanMeierFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TKaplanMeierFrm.EventInBtnClick(Sender: TObject); +var + i: integer; +begin + i := VarList.ItemIndex; + if (i > -1) and (EventEdit.Text = '') then + begin + EventEdit.Text := VarList.Items[i]; + VarList.Items.Delete(i); + end; + UpdateBtnStates; +end; + +procedure TKaplanMeierFrm.EventOutBtnClick(Sender: TObject); +begin + if EventEdit.Text <> '' then + begin + VarList.Items.Add(EventEdit.Text); + EventEdit.Text := ''; + end; + UpdateBtnStates; +end; + + +procedure TKaplanMeierFrm.ComputeBtnClick(Sender: TObject); +var + TwoGroups : boolean; + Size1, Size2, TotalSize, NoDeaths, ThisTime: integer; + mintime, maxtime, tempint, nopoints, tempvalue : integer; + NoCensored, nocats, i, j, k, icase, oldtime, pos, first, last : integer; + noinexp, noincntrl, count, TimeCol, DeathsCol, CensoredCol : integer; + GroupCol : integer; + cumprop, proportion, term1, term2, term3 : double; + E1, E2, O1, O2, Chisquare, ProbChi, Risk, LogRisk, SELogRisk : double; + HiConf, LowConf, HiLogLevel, LowLogLevel, lastexp, lastctr : double; + TimePlot, Dropped, Dropped2, Time, AtRisk, Dead, SurvivalTimes : IntDyneVec; + ExpCnt, CntrlCnt, TotalatRisk, ExpatRisk, CntrlatRisk : IntDyneVec; + Deaths, Group, Censored : IntDyneVec; + ProbPlot, ProbPlot2, CondProb, ExpProp, CntrlProp : DblDyneVec; + CumPropExp, CumPropCntrl : DblDyneVec; + TimeLabel, GroupLabel, DeathsLabel : string; + lReport: TStrings; +begin + // get variable columns and labels + TimeLabel := TimeEdit.Text; + GroupLabel := GroupEdit.Text; + DeathsLabel := EventEdit.Text; + TimeCol := 0; + DeathsCol := 0; + CensoredCol := 0; + GroupCol := 0; + for i := 1 to NoVariables do + begin + if (TimeLabel = OS3MainFrm.DataGrid.Cells[i,0]) then TimeCol := i; + if (DeathsLabel = OS3MainFrm.DataGrid.Cells[i,0]) then DeathsCol := i; + if (GroupLabel = OS3MainFrm.DataGrid.Cells[i,0]) then GroupCol := i; + end; + + if (TimeCol = 0) or (DeathsCol = 0) then + begin + MessageDlg('One or more variables not selected.', mtError, [mbOK], 0); + exit; + end; + + if (GroupEdit.Text = '') then + begin + TwoGroups := false; + Size1 := NoCases; + Size2 := 0; + end else + begin + Size1 := 0; + Size2 := 0; + TwoGroups := true; + for i := 1 to NoCases do + begin + if (StrToInt(OS3MainFrm.DataGrid.Cells[GroupCol,i]) = 1) then + Size1 := Size1 + 1 + else Size2 := Size2 + 1; + end; + end; + + // allocate space for the data + SetLength(SurvivalTimes, NoCases+2); + SetLength(ExpCnt, NoCases+2); + SetLength(CntrlCnt, NoCases+2); + SetLength(TotalatRisk, NoCases+2); + SetLength(ExpatRisk, NoCases+2); + SetLength(CntrlatRisk, NoCases+2); + SetLength(ExpProp, NoCases+2); + SetLength(CntrlProp, NoCases+2); + SetLength(Deaths, NoCases+2); + SetLength(Group, NoCases+2); + SetLength(Censored, NoCases+2); + SetLength(CumPropExp, NoCases+2); + SetLength(CumPropCntrl, NoCases+2); + + // initialize arrays + for i := 0 to NoCases+1 do + begin + SurvivalTimes[i] := 0; + ExpCnt[i] := 0; + CntrlCnt[i] := 0; + TotalatRisk[i] := 0; + ExpatRisk[i] := 0; + CntrlatRisk[i] := 0; + ExpProp[i] := 0.0; + CntrlProp[i] := 0.0; + Deaths[i] := 0; + Group[i] := 0; + Censored[i] := 0; + CumPropExp[i] := 0.0; + CumPropCntrl[i] := 0.0; + end; + + // Get Data + mintime := 0; + maxtime := 0; + + if not TwoGroups then + begin + for i := 1 to NoCases do + begin + SurvivalTimes[i] := StrToInt(OS3MainFrm.DataGrid.Cells[TimeCol,i]); + if (SurvivalTimes[i] > maxtime) then + maxtime := SurvivalTimes[i]; + tempvalue := StrToInt(OS3MainFrm.DataGrid.Cells[DeathsCol,i]); + if (tempvalue = 1) then + Deaths[i] := 1 + else + Deaths[i] := 0; + if (tempvalue = 2) then + Censored[i] := 1 + else + Censored[i] := 0; + end; + + // sort cases by time + for i := 0 to NoCases - 1 do + begin + for j := i + 1 to NoCases do + begin + if (SurvivalTimes[i] > SurvivalTimes[j]) then + begin + tempint := SurvivalTimes[i]; + SurvivalTimes[i] := SurvivalTimes[j]; + SurvivalTimes[j] := tempint; + tempint := Censored[i]; + Censored[i] := Censored[j]; + Censored[j] := tempint; + tempint := Deaths[i]; + Deaths[i] := Deaths[j]; + Deaths[j] := tempint; + end; + end; + end; + + // get number censored in each time slot + nopoints := maxtime + 1; + SetLength(Dropped,nopoints+2); + SetLength(Dropped2,nopoints+2); + for j := 0 to nopoints do + begin + Dropped[j] := 0; + Dropped2[j] := 0; + end; + ThisTime := SurvivalTimes[0]; + for i := 0 to NoCases do + begin + if (ThisTime = SurvivalTimes[i]) then + begin + if(Censored[i] > 0) then + begin + tempint := SurvivalTimes[i] - mintime; + Dropped[tempint] := Dropped[tempint] + Censored[i]; + end; + end + else // new time + begin + ThisTime := SurvivalTimes[i]; + if(Censored[i] > 0) then + begin + tempint := SurvivalTimes[i] - mintime; + Dropped[tempint] := Dropped[tempint] + Censored[i]; + end; + end; + end; + + // calculate expected proportions and adjust survival counts + cumprop := 1.0; + ExpCnt[0] := NoCases; + ExpProp[0] := 1.0; + CumPropExp[0] := 1.0; + + // collapse deaths and censored into first time occurance + icase := 0; + oldtime := SurvivalTimes[0]; + for i := 1 to NoCases do + begin + if (SurvivalTimes[i] <> oldtime) then + begin + oldtime := SurvivalTimes[i]; + icase := i; + end; + + // find no. of deaths at this time + NoDeaths := Deaths[i]; + for j := i+1 to NoCases do + begin + ThisTime := SurvivalTimes[j]; + if ((Deaths[j] > 0) and (oldtime = ThisTime)) then + begin + NoDeaths := NoDeaths + Deaths[j]; + Deaths[icase] := Deaths[icase] + Deaths[j]; + Deaths[j] := 0; + end; + end; + // find no. of censored at this time + NoCensored := Censored[i]; + for j := i+1 to NoCases do + begin + ThisTime := SurvivalTimes[j]; + if((Censored[j] > 0) and (oldtime = ThisTime)) then + begin + NoCensored := NoCensored + Censored[j]; + Censored[icase] := Censored[icase] + Censored[j]; + Censored[j] := 0; + end; + end; + end; +{ + // debug check + FrmOutPut.RichOutPut.Clear(); + for (int i := 0; i <= NoCases; i++) + begin + sprintf(outline,'case %d Day %d Deaths %d Censored %d', + i,SurvivalTimes[i], Deaths[i],Censored[i]); + FrmOutPut.RichOutPut.Lines.Add(outline); + end; + FrmOutPut.ShowModal(); +} + // get no. of categories + for i := 0 to NoCases do + if ((Deaths[i] > 0) or (Censored[i] > 0)) then nocats := nocats + 1; + SetLength(Time,nocats+2); + SetLength(AtRisk,nocats+2); + SetLength(Dead,nocats+2); + SetLength(CondProb,nocats+2); + for i := 0 to nocats do + begin + Time[i] := 0; + AtRisk[i] := 0; + Dead[i] := 0; + CondProb[i] := 0.0; + end; + pos := 0; + for i := 0 to NoCases do + begin + if (Deaths[i] > 0) or (Censored[i] > 0) then + begin + pos := pos + 1; + Time[pos] := SurvivalTimes[i]; + Dead[pos] := Deaths[i]; + Dropped[pos] := Censored[i]; + end; + end; + + Time[0] := 0; + AtRisk[0] := NoCases; + Dead[0] := 0; + Dropped[0] := 0; + CondProb[0] := 0.0; + + lReport := TStringList.Create; + try + lReport.Add(' Time Censored Dead At Risk Probability'); + for i := 1 to nocats do + begin + AtRisk[i] := AtRisk[i-1] - Dead[i-1] - Dropped[i-1]; + CondProb[i-1] := 1.0 - Dead[i-1] / AtRisk[i-1]; + end; + for i := 0 to nocats do + lReport.Add(' %3d %3d %3d %3d %6.3f', [Time[i],Dropped[i],Dead[i],AtRisk[i],CondProb[i]]); + DisplayReport(lReport); + finally + lReport.Free; + end; + + // Get cumulative proportions + for i := 0 to nocats do + begin + if (AtRisk[i] > 0) then + begin + CumPropExp[i] := cumprop * CondProb[i]; + cumprop := CumPropExp[i]; + end; + end; + cumprop := 1.0; + + lReport := TStringList.Create; + try + lReport.Add('KAPLAN-MEIER SURVIVAL TEST'); + lReport.Add(''); + lReport.Add('No Control Group Method'); + lReport.Add(''); + lReport.Add('TIME NO.ALIVE CENSORED DEATHS COND. PROB. CUM.PROP.SURVIVING'); + for i := 0 to nocats do + lReport.Add(' %4d %4d %4d %4d %7.4f %7.4f', [ + Time[i], AtRisk[i], Dropped[i], Deaths[i], CondProb[i], CumPropExp[i] + ]); + DisplayReport(lReport); + finally + lReport.Free; + end; + + if PlotChk.Checked then // plot Y := cumulative proportion surviving, x := time + begin + // Get points to plot + nopoints := maxtime + 1; + SetLength(TimePlot,nocats+2); + SetLength(ProbPlot,nocats+2); + ProbPlot[0] := 1.0; + for j := 0 to nocats do + begin + TimePlot[j] := Time[j]; + ProbPlot[j] := CumPropExp[j]; + end; + BlankFrm.Show; + PlotXY(TimePlot, ProbPlot, Dropped, Dropped2, maxtime, 0, 1.0, 0.0, nocats, 'TIME', 'PROBABILITY', 1); + end; // end if graph1 + + ProbPlot := nil; + TimePlot := nil; + CondProb := nil; + Dead := nil; + AtRisk := nil; + Time := nil; + end // end if not two groups +//============================================================================// + else // Experimental and control groups + begin + // obtain no. in experimental and control groups + ExpCnt[0] := Size1; + CntrlCnt[0] := Size2; + TotalSize := Size1 + Size2; + CumPropExp[0] := 1.0; + CumPropCntrl[0] := 1.0; + TotalatRisk[0] := TotalSize; + O1 := 0; + O2 := 0; + { + ShowMessage(Format('Total Group 1 = %d, Total Group 2 = %d, Grand Total = %d', + [ ExpCnt[0], CntrlCnt[0], TotalSize ])); + } + // Now read values. Note storage starts in 1, not 0! + for i := 1 to NoCases do + begin + SurvivalTimes[i] := StrToInt(OS3MainFrm.DataGrid.Cells[TimeCol,i]); + if (SurvivalTimes[i] > maxtime) then + maxtime := SurvivalTimes[i]; + tempvalue := StrToInt(OS3MainFrm.DataGrid.Cells[DeathsCol,i]); + if (tempvalue = 1) then + Deaths[i] := 1 + else + Deaths[i] := 0; + if (tempvalue = 2) then + Censored[i] := 1 + else + Censored[i] := 0; + Group[i] := StrToInt(OS3MainFrm.DataGrid.Cells[GroupCol,i]); + end; + + // sort cases by time + for i := 1 to NoCases - 1 do + begin + for j := i + 1 to NoCases do + begin + if (SurvivalTimes[i] > SurvivalTimes[j]) then + begin + tempint := SurvivalTimes[i]; + SurvivalTimes[i] := SurvivalTimes[j]; + SurvivalTimes[j] := tempint; + tempint := Censored[i]; + Censored[i] := Censored[j]; + Censored[j] := tempint; + tempint := Deaths[i]; + Deaths[i] := Deaths[j]; + Deaths[j] := tempint; + tempint := Group[i]; + Group[i] := Group[j]; + Group[j] := tempint; + end; + end; + end; + + // sort cases within each time slot by deaths first then censored + ThisTime := SurvivalTimes[1]; + first := 1; + last := 1; + for i := 1 to NoCases do + begin + if (ThisTime = SurvivalTimes[i]) then + begin + last := i; + continue; + end + else // sort the cases from first to last on event (descending) + begin + if (last > first) then // more than 1 to sort + begin + for j := first to last - 1 do + begin + for k := j + 1 to last do + begin + if (Deaths[j] < Deaths[k] ) then // swap + begin + tempint := Censored[j]; + Censored[j] := Censored[k]; + Censored[k] := tempint; + tempint := Deaths[j]; + Deaths[j] := Deaths[k]; + Deaths[k] := tempint; + tempint := Group[j]; + Group[j] := Group[k]; + Group[k] := tempint; + end; + end; // next k + end; // next j + end; // if last > first + end; // end else sort + + first := last + 1; + ThisTime := SurvivalTimes[first]; + last := first; + end; // next i + + // get number censored in each time slot + nopoints := maxtime + 1; + SetLength(Dropped,nopoints+2); + SetLength(Dropped2,nopoints+2); + for j := 0 to nopoints do + begin + Dropped[j] := 0; + Dropped2[j] := 0; + end; + ThisTime := SurvivalTimes[1]; + for i := 1 to NoCases do + begin + if (ThisTime = SurvivalTimes[i]) then + begin + if(Censored[i] > 0) then + begin + tempint := SurvivalTimes[i] - mintime; + if (Group[i] = 1) then + Dropped[tempint] := Dropped[tempint] + Censored[i] + else + Dropped2[tempint] := Dropped2[tempint] + Censored[i]; + end; + end + else // new time + begin + ThisTime := SurvivalTimes[i]; + if (Censored[i] > 0) then + begin + tempint := SurvivalTimes[i] - mintime; + if (Group[i] = 1) then + Dropped[tempint] := Dropped[tempint] + Censored[i] + else Dropped2[tempint] := Dropped2[tempint] + Censored[i]; + end; + end; + end; + + for i := 0 to NoCases do + begin + noinexp := 0; + noincntrl := 0; + if (Deaths[i] > 0) then + begin + // find no. of deaths at this time + NoDeaths := Deaths[i]; + ThisTime := SurvivalTimes[i]; + for j := i+1 to NoCases do + begin + if ((Deaths[j] > 0) and (SurvivalTimes[j] = ThisTime)) then + begin + NoDeaths := NoDeaths + Deaths[j]; + Deaths[i] := Deaths[i] + Deaths[j]; + Deaths[j] := 0; + end; + end; + if (TotalatRisk[i] > 0) then + begin + term1 := ExpCnt[i]; + term2 := TotalatRisk[i]; + term3 := NoDeaths; + ExpatRisk[i] := ceil((term1 / term2) * term3); +// ExpatRisk[i] := (ExpCnt[i]) / TotalatRisk[i]) * NoDeaths; + term1 := CntrlCnt[i]; + CntrlatRisk[i] := ceil((term1 / term2) * term3); +// CntrlatRisk[i] := (CntrlCnt[i] / TotalatRisk[i]) * NoDeaths; + end; + if (i < NoCases-1) then + TotalAtRisk[i+1] := TotalAtRisk[i] - Deaths[i]; + // find no. in exp. or control groups and decrement their counts + for j := 1 to NoCases do + begin + if (ThisTime = SurvivalTimes[j]) and (Censored[j] = 0) then + begin + if (Group[j] = 1) then + begin + noinexp := noinexp + 1; + O1 := O1 + 1; + end; + if (Group[j] = 2) then + begin + noincntrl := noincntrl + 1; + O2 := O2 + 1; + end; + end; + end; + if (i < NoCases) and (noinexp > 0) then + begin + term1 := ExpCnt[i]; + term2 := noinexp; + term3 := ExpCnt[i]; + ExpProp[i] := (term1 - term2) / term3; +// ExpProp[i] := (ExpCnt[i] - noinexp) / ExpCnt[i]; + if (i > 0) then + CumPropExp[i] := CumPropExp[i-1] * ExpProp[i]; + ExpCnt[i+1] := ExpCnt[i] - noinexp; + CumPropExp[i+1] := CumPropExp[i]; + end; + if (i < NoCases) and (noinexp = 0) then + begin + ExpCnt[i+1] := ExpCnt[i]; + CumPropExp[i+1] := CumPropExp[i]; + end; + if (i < NoCases) and (noincntrl > 0) then + begin + term1 := CntrlCnt[i]; + term2 := noincntrl; + term3 := CntrlCnt[i]; + CntrlProp[i] := (term1 - term2) / term3; +// CntrlProp[i] := (CntrlCnt[i] - noincntrl) / CntrlCnt[i]; + if (i > 0) then + CumPropCntrl[i] := CumPropCntrl[i-1] * CntrlProp[i]; + CntrlCnt[i+1] := CntrlCnt[i] - noincntrl; + CumPropCntrl[i+1] := CumPropCntrl[i]; + end; + if ( (i < NoCases) and (noincntrl = 0) ) then + begin + CntrlCnt[i+1] := CntrlCnt[i]; + CumPropCntrl[i+1] := CumPropCntrl[i]; + end; + end; // end if deaths[i] > 0 + + if ( (Censored[i] > 0) and (i < NoCases) ) then + begin + if (Group[i] = 1) then + begin + ExpCnt[i+1] := ExpCnt[i] - 1; + CntrlCnt[i+1] := CntrlCnt[i]; + ExpProp[i+1] := ExpProp[i]; + CumPropExp[i+1] := CumPropExp[i]; + CumPropCntrl[i+1] := CumPropCntrl[i]; + end; + if (Group[i] = 2) then + begin + CntrlCnt[i+1] := CntrlCnt[i] - 1; + ExpCnt[i+1] := ExpCnt[i]; + CntrlProp[i+1] := CntrlProp[i]; + CumPropCntrl[i+1] := CumPropCntrl[i]; + CumPropExp[i+1] := CumPropExp[i]; + end; + TotalatRisk[i+1] := TotalatRisk[i] - 1; + end; + + if (Deaths[i] = 0) and (Censored[i] = 0) and (i < NoCases) then + begin + ExpCnt[i+1] := ExpCnt[i]; + CntrlCnt[i+1] := CntrlCnt[i]; + CumPropExp[i+1] := CumPropExp[i]; + CumPropCntrl[i+1] := CumPropCntrl[i]; + TotalatRisk[i+1] := TotalatRisk[i]; + end; + end; // next case i + + // Now calculate chisquare, relative risk (r), logr, and S.E. of log risk + E1 := 0.0; + for i := 0 to NoCases do E1 := E1 + ExpatRisk[i]; + E2 := (O1 + O2) - E1; + Chisquare := ((O1 - E1) * (O1 - E1)) / E1 + ((O2 - E2) * (O2 - E2)) / E2; + ProbChi := chisquaredprob(Chisquare,1); + Risk := (O1 / E1) / (O2 / E2); + LogRisk := ln(Risk); + SELogRisk := sqrt(1.0/E1 + 1.0/E2); + HiConf := LogRisk + (inversez(0.975) * SELogRisk); + LowConf := LogRisk - (inversez(0.975) * SELogRisk); + HiLogLevel := exp(HiConf); + LowLogLevel := exp(LowConf); + end; + + // Print Results + if (TwoGroups and PrintChk.Checked) then // both experimental and control groups + begin + lReport := TStringList.Create; + try + lReport.Add('KAPLAN-MEIER SURVIVAL TEST'); + lReport.Add(''); + lReport.Add('Comparison of Two Groups Methd'); + lReport.Add(''); + lReport.Add('TIME GROUP CENSORED TOTAL AT EVENTS AT RISK IN EXPECTED NO. AT RISK IN EXPECTED NO.'); + lReport.Add(' RISK GROUP 1 EVENTS IN 1 GROUP 2 EVENTS IN 2'); + + for i := 1 to NoCases+1 do + lReport.Add('%4d %4d %4d %4d %4d %4d %7d %4d %7d', [ + SurvivalTimes[i-1], Group[i-1], Censored[i-1], TotalAtRisk[i-1], + Deaths[i-1], ExpCnt[i-1], ExpAtRisk[i-1], CntrlCnt[i-1], CntrlAtRisk[i-1] + ]); + + lReport.Add(''); + lReport.Add(''); + lReport.Add('TIME DEATHS GROUP AT RISK PROPORTION CUMULATIVE'); + lReport.Add(' SURVIVING PROP.SURVIVING'); + + for i := 1 to NoCases do + begin + if (Group[i] = 1) then + begin + count := ExpCnt[i]; + proportion := ExpProp[i]; + cumprop := CumPropExp[i]; + end else + begin + count := CntrlCnt[i]; + proportion := CntrlProp[i]; + cumprop := CumPropCntrl[i]; + end; + lReport.Add('%4d %4d %4d %4d %7.4f %7.4f', [ + SurvivalTimes[i], Deaths[i], Group[i], count, proportion, cumprop + ]); + end; + + lReport.Add(''); + lReport.Add('Total Expected Events for Experimental Group: %8.3f', [E1]); + lReport.Add('Observed Events for Experimental Group: %8.3f', [O1]); + lReport.Add('Total Expected Events for Control Group: %8.3f', [E2]); + lReport.Add('Observed Events for Control Group: %8.3f', [O2]); + lReport.Add('Chisquare: %8.3f', [ChiSquare]); + lReport.Add(' with probability: %8.3f', [ProbChi]); + lReport.Add('Risk: %8.3f', [Risk]); + lReport.Add('Log Risk: %8.3f', [LogRisk]); + lReport.Add('Std.Err. Log Risk: %8.3f', [SELogRisk]); + lReport.Add('95 Percent Confidence interval for Log Risk: (%.3f ... %.3f)', [LowConf, HiConf]); + lReport.Add('95 Percent Confidence interval for Risk: (%.3f ... %.3f)', [LowLogLevel, HiLogLevel]); + + // Plot data output + lReport.Add(''); + lReport.Add('============================================================================'); + lReport.Add(''); + lReport.Add('EXPERIMENTAL GROUP CUMULATIVE PROBABILITY'); + lReport.Add('CASE TIME DEATHS CENSORED CUM.PROB.'); + for i := 1 to NoCases do + if (Group[i] = 1) then + lReport.Add('%3d %3d %3d %3d %5.3f',[ + i, SurvivalTimes[i], Deaths[i], Censored[i], CumPropExp[i] + ]); + lReport.Add(''); + lReport.Add('============================================================================'); + lReport.Add(''); + lReport.Add('CONTROL GROUP CUMULATIVE PROBABILITY'); + lReport.Add('CASE TIME DEATHS CENSORED CUM.PROB.'); + for i := 1 to NoCases do + if (Group[i] = 2) then + lReport.Add('%3d %3d %3d %3d %5.3f', [ + i, SurvivalTimes[i], Deaths[i], Censored[i], CumPropCntrl[i] + ]); + lReport.Add(''); + + DisplayReport(lReport); + finally + lReport.Free; + end; + end; // if 2 groups and printit + + if PlotChk.Checked then // plot cumulative proportion surviving (Y) against time (X) + begin + nopoints := maxtime + 1; + SetLength(TimePlot,nopoints+2); + SetLength(ProbPlot,nopoints+2); + SetLength(ProbPlot2,nopoints+2); + ProbPlot[0] := 1.0; + ProbPlot2[0] := 1.0; + lastexp := 1.0; + lastctr := 1.0; + for i := 0 to nopoints do + begin + TimePlot[i] := 0; + ProbPlot[i] := 1.0; + ProbPlot2[i] := 1.0; + end; + TimePlot[0] := 0; + mintime := 0; + for i := 1 to nopoints do + begin + TimePlot[i] := i; + for j := 1 to NoCases do + begin + if (SurvivalTimes[j] = i) then + begin + if (Group[j] = 1) then + begin + ProbPlot[i] := CumPropExp[j]; // ExpProp[j]; + lastexp := CumPropExp[j]; // ExpProp[j]; + end; + if (Group[j] = 2) then + begin + ProbPlot2[i] := CumPropCntrl[j]; //CntrlProp[j]; + lastctr := CumPropCntrl[j]; // CntrlProp[j]; + end; + end + else + begin + if (Group[j] = 1) then ProbPlot[i] := lastexp; + if (Group[j] = 2) then ProbPlot2[i] := lastctr; + end; + end; + end; + + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Show; + PlotXY(TimePlot, ProbPlot, Dropped, Dropped2, maxtime, 0, 1.0, 0.0, nopoints, 'TIME', 'PROBABILITY', 1); + PlotXY(TimePlot, ProbPlot2, Dropped, Dropped2, maxtime, 0, 1.0, 0.0, nopoints, 'TIME', 'PROBABILITY', 2); + + ProbPlot2 := nil; + ProbPlot := nil; + TimePlot := nil; + end; // if graph plot := 1 + + Dropped2 := nil; + Dropped := nil; + + // clean up memory + Dropped2 := nil; + Dropped := nil; + CumPropCntrl := nil; + CumPropExp := nil; + Censored := nil; + Group := nil; + Deaths := nil; + CntrlProp := nil; + ExpProp := nil; + CntrlatRisk := nil; + ExpatRisk := nil; + TotalatRisk := nil; + CntrlCnt := nil; + ExpCnt := nil; + SurvivalTimes := nil; +end; + +procedure TKaplanMeierFrm.PlotXY(var Xpoints: IntDyneVec; + var Ypoints: DblDyneVec; var Dropped: IntDyneVec; var Dropped2: IntDyneVec; + Xmax, Xmin, Ymax, Ymin: double; N: integer; XEdit: string; YEdit: string; + curveno: integer); +var + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; + vhi, hwide, offset, strhi, imagehi : integer; + noxvalues, digitwidth, Xvalue, xvalincr, oldxpos : integer; + valincr, Yvalue, value, oldypos, term1, term2, term3 : double; + Title, outline : string; +label again, second; + +begin + if (curveno = 2) then goto second; + BlankFrm.Image1.Canvas.Font.Color := clBlack; + Title := 'SURVIVAL CURVE'; + BlankFrm.Caption := Title; + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + BlankFrm.Image1.Canvas.FloodFill(0,0,clWhite,fsBorder); + vtop := 20; + vbottom := ceil(imagehi) - 130; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + + // Draw chart border +// ImageFrm.Image.Canvas.Rectangle(0,0,imagewide,imagehi); + + // draw horizontal axis + noxvalues := N; + xvalincr := 1; + digitwidth := BlankFrm.Image1.Canvas.TextWidth('9'); +again: + if ( (noxvalues * 4 * digitwidth) > hwide) then + begin + noxvalues := noxvalues div 2; + xvalincr := 2 * xvalincr; + goto again; + end; + BlankFrm.Image1.Canvas.Pen.Style := psSolid; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom); + for i := 1 to noxvalues do + begin + ypos := vbottom; + Xvalue := Xpoints[1] + xvalincr * (i - 1); // Xmin + xvalincr * (i - 1); + term1 := (Xvalue - Xmin) / (Xmax - Xmin); + term2 := hwide; + term3 := hleft; + xpos := floor((term1 * term2) + term3); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + outline := format('%d',[Xvalue]); + Title := outline; + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + xpos := xpos - offset; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(XEdit) div 2); + ypos := vbottom + 22; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,XEdit); + + // Draw vertical axis + Title := YEdit; + xpos := hleft - BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + ypos := vtop - BlankFrm.Image1.Canvas.TextHeight(Title); + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,YEdit); + xpos := hleft; + ypos := vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := vbottom; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + valincr := (Ymax - Ymin) / 10.0; + for i := 1 to 11 do + begin + value := Ymax - ((i-1) * valincr); + outline := format('%8.2f',[value]); + Title := outline; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := 10; + Yvalue := Ymax - (valincr * (i-1)); + ypos := ceil(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + xpos := hleft; + ypos := ypos + strhi div 2; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hleft - 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // get xpos and ypos for first point to second point +second: xpos := hleft; + ypos := vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); // Probability := 1 at time 0 + if (curveno = 1) then BlankFrm.Image1.Canvas.Pen.Color := clNavy + else BlankFrm.Image1.Canvas.Pen.Color := clRed; + ypos := ceil(vhi * ( (Ymax - Ypoints[0]) / (Ymax - Ymin))); + ypos := ypos + vtop; + xpos := ceil(hwide * ( (Xpoints[1] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + + // draw points for x and y pairs + oldxpos := xpos; + oldypos := ypos; + for i := 1 to N - 1 do + begin + ypos := ceil(vhi * ( (Ymax - Ypoints[i]) / (Ymax - Ymin))); + ypos := ypos + vtop; + if (ypos <> oldypos) then // draw line down to new ypos using old xpos + begin + if (curveno = 1) then BlankFrm.Image1.Canvas.Pen.Style := psSolid + else BlankFrm.Image1.Canvas.Pen.Style := psDot; + BlankFrm.Image1.Canvas.LineTo(oldxpos,ypos); + end; + xpos := ceil(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + oldxpos := xpos; + oldypos := ypos; + BlankFrm.Image1.Canvas.Pen.Style := psSolid; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // show censored + BlankFrm.Image1.Canvas.Pen.Style := psSolid; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + for i := 1 to N do + begin + if ((Dropped[i] = 0) and (curveno = 1)) then continue; + if ((Dropped2[i] = 0) and (curveno = 2)) then continue; + if (curveno = 1) then + begin + BlankFrm.Image1.Canvas.Font.Color := clNavy; + ypos := vbottom + 35; + xpos := ceil(hwide * ((Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + outline := format('%d',[Dropped[i]]); + Title := outline; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end + else + begin + BlankFrm.Image1.Canvas.Font.Color := clRed; + ypos := vbottom + 48; + xpos := ceil(hwide * ((Xpoints[i] - Xmin) / (Xmax - Xmin))); + xpos := xpos + hleft; + outline := format('%d',[Dropped2[i]]); + Title := outline; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + end; + + BlankFrm.Image1.Canvas.Font.Color := clBlack; + ypos := vbottom + 60; + Title := 'NUMBER CENSORED'; + xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(Title) div 2); + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + BlankFrm.Image1.Canvas.Font.Color := clNavy; + Title := 'EXPERIMENTAL'; + xpos := 5; + ypos := vbottom + 35; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + if (curveno = 2) then + begin + BlankFrm.Image1.Canvas.Font.Color := clRed; + Title := 'CONTROL'; + xpos := 5; + ypos := vbottom + 48; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; +end; + +procedure TKaplanMeierFrm.UpdateBtnStates; +var + lSelected: Boolean; + i: Integer; +begin + lSelected := false; + for i := 0 to VarList.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + TimeInBtn.Enabled := lSelected and (TimeEdit.Text = ''); + EventInBtn.Enabled := lSelected and (EventEdit.Text = ''); + GroupInBtn.Enabled := lSelected and (GroupEdit.Text = ''); + TimeOutBtn.Enabled := (TimeEdit.Text <> ''); + EventOutBtn.Enabled := (EventEdit.Text <> ''); + GroupOutBtn.Enabled := (GroupEdit.Text <> ''); +end; + +procedure TKaplanMeierFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I kaplanmeierunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/kappaunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/kappaunit.lfm new file mode 100644 index 000000000..f02cbd9af --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/kappaunit.lfm @@ -0,0 +1,440 @@ +object WeightedKappaFrm: TWeightedKappaFrm + Left = 448 + Height = 560 + Top = 184 + Width = 539 + AutoSize = True + Caption = 'Kappa and Weighted Kappa' + ClientHeight = 560 + ClientWidth = 539 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object InputGroup: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 89 + Top = 8 + Width = 488 + Align = alCustom + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Input Options:' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 69 + ClientWidth = 484 + Items.Strings = ( + 'Count cases classified by row and column variables in the data grid' + 'Use frequencies in a variable for a given row variable value and column variable value.' + 'Use proportions in a variable for a given row variable value and column variable value.' + ) + OnClick = InputGroupClick + TabOrder = 0 + end + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = InputGroup + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 105 + Width = 46 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = RowIn + AnchorSideBottom.Control = NCasesEdit + Left = 8 + Height = 358 + Top = 122 + Width = 265 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 1 + end + object NCasesLbl: TLabel + AnchorSideLeft.Control = VarList + AnchorSideTop.Control = NCasesEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NCasesEdit + Left = 8 + Height = 15 + Top = 492 + Width = 122 + BorderSpacing.Right = 8 + Caption = 'Total Number of Cases:' + ParentColor = False + end + object NCasesEdit: TEdit + AnchorSideLeft.Control = NCasesLbl + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 138 + Height = 23 + Top = 488 + Width = 54 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + TabOrder = 2 + Text = 'NCasesEdit' + end + object RowIn: TBitBtn + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = VarList + Left = 281 + Height = 28 + Top = 122 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = RowInClick + Spacing = 0 + TabOrder = 3 + end + object RowOut: TBitBtn + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = RowIn + AnchorSideTop.Side = asrBottom + Left = 281 + Height = 28 + Top = 154 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = RowOutClick + Spacing = 0 + TabOrder = 4 + end + object ColIn: TBitBtn + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = RowOut + AnchorSideTop.Side = asrBottom + Left = 281 + Height = 28 + Top = 202 + Width = 28 + BorderSpacing.Top = 20 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ColInClick + Spacing = 0 + TabOrder = 6 + end + object ColOut: TBitBtn + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = ColIn + AnchorSideTop.Side = asrBottom + Left = 281 + Height = 28 + Top = 234 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ColOutClick + Spacing = 0 + TabOrder = 7 + end + object DepIn: TBitBtn + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = ColOut + AnchorSideTop.Side = asrBottom + Left = 281 + Height = 28 + Top = 282 + Width = 28 + BorderSpacing.Top = 20 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInClick + Spacing = 0 + TabOrder = 9 + end + object DepOut: TBitBtn + AnchorSideLeft.Control = OptionsGroup + AnchorSideTop.Control = DepIn + AnchorSideTop.Side = asrBottom + Left = 281 + Height = 28 + Top = 314 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutClick + Spacing = 0 + TabOrder = 10 + end + object Label2: TLabel + AnchorSideLeft.Control = RaterAEdit + AnchorSideBottom.Control = RaterAEdit + Left = 317 + Height = 15 + Top = 130 + Width = 38 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Rater A' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = RaterBEdit + AnchorSideBottom.Control = RaterBEdit + Left = 317 + Height = 15 + Top = 210 + Width = 37 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Rater B' + ParentColor = False + end + object DepLbl: TLabel + AnchorSideLeft.Control = DepEdit + AnchorSideBottom.Control = DepEdit + Left = 317 + Height = 15 + Top = 290 + Width = 99 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Variable to Analyze' + ParentColor = False + end + object RaterAEdit: TEdit + AnchorSideLeft.Control = RowIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = OptionsGroup + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = RowOut + AnchorSideBottom.Side = asrBottom + Left = 317 + Height = 23 + Top = 147 + Width = 214 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 5 + Text = 'RaterAEdit' + end + object RaterBEdit: TEdit + AnchorSideLeft.Control = ColIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = OptionsGroup + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ColOut + AnchorSideBottom.Side = asrBottom + Left = 317 + Height = 23 + Top = 227 + Width = 214 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 8 + Text = 'RaterBEdit' + end + object DepEdit: TEdit + AnchorSideLeft.Control = DepOut + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = OptionsGroup + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOut + AnchorSideBottom.Side = asrBottom + Left = 317 + Height = 23 + Top = 307 + Width = 214 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 11 + Text = 'DepEdit' + end + object OptionsGroup: TGroupBox + AnchorSideLeft.Control = RowIn + AnchorSideTop.Control = DepOut + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 281 + Height = 156 + Top = 354 + Width = 250 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + Caption = 'Options:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 136 + ClientWidth = 246 + TabOrder = 12 + object ObsChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 222 + Caption = 'Show Observed Frequencies' + TabOrder = 0 + end + object ExpChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 222 + Caption = 'Show Expected Frequencies' + TabOrder = 1 + end + object PropChk: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 222 + Caption = 'Show Row and Column Proportions' + TabOrder = 2 + end + object ChiChk: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 222 + Caption = 'Show Cell Chi Square Values' + TabOrder = 3 + end + object YatesChk: TCheckBox + Left = 12 + Height = 19 + Top = 90 + Width = 222 + Caption = 'Use Yates'' Correction for a 2 by 2 table' + TabOrder = 4 + end + object SaveChk: TCheckBox + Left = 12 + Height = 19 + Top = 111 + Width = 222 + Caption = 'Save as a File of Frequency Data' + TabOrder = 5 + end + end + object ResetBtn: TButton + AnchorSideTop.Control = CloseBtn + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Side = asrBottom + Left = 330 + Height = 25 + Top = 527 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 13 + end + object ComputeBtn: TButton + AnchorSideTop.Control = CloseBtn + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Side = asrBottom + Left = 392 + Height = 25 + Top = 527 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 14 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 476 + Height = 25 + Top = 527 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 15 + end + object HelpBtn: TButton + Tag = 128 + AnchorSideTop.Control = CloseBtn + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Side = asrBottom + Left = 271 + Height = 25 + Top = 527 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 16 + end + object Bevel1: TBevel + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 519 + Width = 541 + Anchors = [akLeft, akRight, akBottom] + Shape = bsTopLine + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/kappaunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/kappaunit.pas new file mode 100644 index 000000000..1c06e6841 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/kappaunit.pas @@ -0,0 +1,810 @@ +unit KappaUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, + MainUnit, Globals, OutputUnit, FunctionsLib, DictionaryUnit, DataProcs, + MatrixLib, ContextHelpUnit; + +type + + { TWeightedKappaFrm } + + TWeightedKappaFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + ObsChk: TCheckBox; + ExpChk: TCheckBox; + PropChk: TCheckBox; + ChiChk: TCheckBox; + YatesChk: TCheckBox; + SaveChk: TCheckBox; + OptionsGroup: TGroupBox; + NCasesEdit: TEdit; + NCasesLbl: TLabel; + RowIn: TBitBtn; + RowOut: TBitBtn; + ColIn: TBitBtn; + ColOut: TBitBtn; + DepIn: TBitBtn; + DepOut: TBitBtn; + RaterAEdit: TEdit; + RaterBEdit: TEdit; + DepEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + DepLbl: TLabel; + VarList: TListBox; + InputGroup: TRadioGroup; + procedure ColInClick(Sender: TObject); + procedure ColOutClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure DepInClick(Sender: TObject); + procedure DepOutClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InputGroupClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure RowInClick(Sender: TObject); + procedure RowOutClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + WeightedKappaFrm: TWeightedKappaFrm; + +implementation + +uses + Math; + +{ TWeightedKappaFrm } + +procedure TWeightedKappaFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + RaterAEdit.Text := ''; + RaterBEdit.Text := ''; + DepEdit.Text := ''; + NCasesEdit.Text := ''; + InputGroup.ItemIndex := 0; + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TWeightedKappaFrm.RowInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (RaterAEdit.Text = '') then + begin + RaterAEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TWeightedKappaFrm.RowOutClick(Sender: TObject); +begin + if RaterAEdit.Text <> '' then + begin + VarList.Items.Add(RaterAEdit.Text); + RaterAEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TWeightedKappaFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + // Autosizing is not working for whatever reason... + //AutoSize := false; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + //VarList.Constraints.MinHeight := OptionsGroup.Top + OptionsGroup.Height - NCasesEdit.Height - VarList.BorderSpacing.Bottom; + Constraints.MinWidth := Width; + Constraints.MinHeight := OptionsGroup.Top + OptionsGroup.Height + CloseBtn.Height + 2*CloseBtn.BorderSpacing.Bottom; + + FAutoSized := true; +end; + +procedure TWeightedKappaFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TWeightedKappaFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TWeightedKappaFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TWeightedKappaFrm.InputGroupClick(Sender: TObject); +begin + (* + case InputGroup.ItemIndex of + 0: begin // have to count cases in each row and col. combination + NCasesEdit.Enabled := false; + NCasesLbl.Enabled := false; + DepEdit.Enabled := false; + end; + 1: begin // frequencies available for each row and column combo + DepLbl.Enabled := true; + NCasesLbl.Enabled := false; + NCasesEdit.Enabled := false; + DepEdit.Enabled := true; + end; + 2: begin // only proportions available - get N size + DepLbl.Enabled := true; + NCasesEdit.Enabled := true; + NCasesLbl.Enabled := true; + DepEdit.Visible := Enabled; + end; + end; + *) + UpdateBtnStates; +(* + if (index = 2) then // only proportions available - get N size + begin + DepLbl.Visible := true; + NCasesEdit.Visible := true; + NCasesEdit.SetFocus; + DepIn.Enabled := true; + DepOut.Enabled := false; + DepIn.Visible := true; + DepOut.Visible := true; + DepEdit.Visible := true; + NCasesLbl.Visible := true; + end; + if (index = 1) then // frequencies available for each row and column combo + begin + DepLbl.Visible := true; + NCasesEdit.Visible := false; + DepIn.Enabled := true; + DepOut.Enabled := false; + DepIn.Visible := true; + DepOut.Visible := true; + DepEdit.Visible := true; + NCasesLbl.Visible := false; + end; + if (index = 0) then // have to count cases in each row and col. combination + begin + NCasesEdit.Visible := false; + DepIn.Visible := false; + DepOut.Visible := false; + DepEdit.Visible := false; + DepLbl.Visible := false; + NCasesLbl.Visible := false; + end; + *) +end; + +procedure TWeightedKappaFrm.ColInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (RaterBEdit.Text = '') then + begin + RaterBEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TWeightedKappaFrm.ColOutClick(Sender: TObject); +begin + if RaterBEdit.Text <> '' then + begin + VarList.Items.Add(RaterBEdit.Text); + RaterBEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TWeightedKappaFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, RowNo, ColNo, DepNo, MinRow, MaxRow, MinCol, MaxCol : integer; + Row, Col, NoSelected, Ncases, Nrows, Ncols, FObs, df : integer; + RowLabels, ColLabels : StrDyneVec; + ColNoSelected : IntDyneVec; + cellstring : string; + outline : string; + Freq : IntDyneMat; + Prop, Expected, CellChi : DblDyneMat; + PObs, ChiSquare, ProbChi, likelihood, Fval, phi : double; + yates, aresult : boolean; + title : string; + Adjchisqr, Adjprobchi, problikelihood, pearsonr : double; + pobserved, SumX, SumY, VarX, VarY, obsdiag, expdiag, expnondiag : double; + pexpected, MantelHaenszel, MHprob, CoefCont, CramerV, Kappa : double; + Frq : integer; + weights, quadweights : DblDyneMat; + lReport: TStrings; +begin + if RaterAEdit.Text = '' then + begin + MessageDlg('Rater A is not specified.', mtError, [mbOK], 0); + exit; + end; + + if RaterBEdit.Text = '' then + begin + MessageDlg('Rater B is not specified.', mtError, [mbOK], 0); + exit; + end; + + if InputGroup.ItemIndex > 0 then + begin + if DepEdit.Text = '' then + begin + MessageDlg('Dependent variable is not specified.', mtError, [mbOK], 0); + exit; + end; + end; + + if InputGroup.ItemIndex = 2 then + begin + if NCasesEdit.Text = '' then + begin + NCasesEdit.SetFocus; + MessageDlg('Total number of cases is not specified.', mtError, [mbOK], 0); + exit; + end; + if not TryStrToInt(NCasesEdit.Text, i) then + begin + NCasesEdit.SetFocus; + MessageDlg('Total number of cases is not a valid number.', mtError, [mbOK], 0); + exit; + end; + end; + + SetLength(ColNoSelected,NoVariables); + yates := false; + RowNo := 0; + ColNo := 0; + DepNo := 0; + pobserved := 0.0; + pexpected := 0.0; + + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = RaterAEdit.Text) then RowNo := i; + if (cellstring = RaterBEdit.Text) then ColNo := i; + if (cellstring = DepEdit.Text) then DepNo := i; + end; + (* + if ((InputGroup.ItemIndex > 0) and (DepNo = 0)) then + begin + ShowMessage('ERROR! You must select a dependent variable.'); + ColNoSelected := nil; + exit; + end; + if ((RowNo = 0) or (ColNo = 0)) then // || (DepNo == 0)) + begin + ShowMessage('ERROR! A required variable has not been selected.'); + ColNoSelected := nil; + exit; + end; + *) + + aresult := ValidValue(RowNo,1); + if not aresult then + begin + ColNoSelected := nil; + exit; + end; + aresult := ValidValue(ColNo,1); + if not aresult then + begin + ColNoSelected := nil; + exit; + end; + + ColNoSelected[0] := RowNo; + ColNoSelected[1] := ColNo; + NoSelected := 2; + if (InputGroup.ItemIndex > 0) then // for reading proportions or frequencies + begin + NoSelected := 3; + ColNoSelected[2] := DepNo; + end; + if (InputGroup.ItemIndex = 1) then + begin + aresult := ValidValue(DepNo,1); + if (aresult = false) then + begin + ColNoSelected := nil; + exit; + end; + end; + if (InputGroup.ItemIndex = 2) then + begin + aresult := ValidValue(DepNo,0); + if (aresult = false) then + begin + ColNoSelected := nil; + exit; + end; + end; + + // get min and max of row and col numbers + MinRow := 1000; + MaxRow := 0; + MinCol := 1000; + MaxCol := 0; + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + Row := round(StrToFloat(OS3MainFrm.DataGrid.Cells[RowNo,i])); + Col := round(StrToFloat(OS3MainFrm.DataGrid.Cells[ColNo,i])); + if (Row > MaxRow) then MaxRow := Row; + if (Row < MinRow) then MinRow := Row; + if (Col > MaxCol) then MaxCol := Col; + if (Col < MinCol) then MinCol := Col; + end; + Nrows := MaxRow - MinRow + 1; + Ncols := MaxCol - MinCol + 1; + + // allocate and initialize + SetLength(Freq,Nrows+1,Ncols+1); + SetLength(Prop,Nrows+1,Ncols+1); + SetLength(Expected,Nrows,Ncols); + SetLength(CellChi,Nrows,Ncols); + SetLength(RowLabels,Nrows+1); + SetLength(ColLabels,Ncols+1); + for i := 1 to Nrows + 1 do + for j := 1 to Ncols + 1 do Freq[i-1,j-1] := 0; + for i := 1 to Nrows do + RowLabels[i-1] := Format('Row %d', [i]); + RowLabels[Nrows] := 'Total'; + for j := 1 to Ncols do + ColLabels[j-1] := Format('COL. %d', [j]); + ColLabels[Ncols] := 'Total'; + + // get cell data + Ncases := 0; + if (InputGroup.ItemIndex = 0) then + begin // count number of cases in each row and column combination + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then + continue; + Ncases := Ncases + 1; + Row := round(StrToFloat(OS3MainFrm.DataGrid.Cells[RowNo,i])); + Col := round(StrToFloat(OS3MainFrm.DataGrid.Cells[ColNo,i])); + Row := Row - MinRow + 1; + Col := Col - MinCol + 1; + Freq[Row-1,Col-1] := Freq[Row-1,Col-1] + 1; + end; + end; + if (InputGroup.ItemIndex = 1) then // read frequencies data from grid + begin + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + Row := round(StrToFloat(OS3MainFrm.DataGrid.Cells[RowNo,i])); + Col := round(StrToFloat(OS3MainFrm.DataGrid.Cells[ColNo,i])); + Row := Row - MinRow + 1; + Col := Col - MinCol + 1; + FObs := round(StrToFloat(OS3MainFrm.DataGrid.Cells[DepNo,i])); + Freq[Row-1,Col-1] := Freq[Row-1,Col-1] + FObs; + Ncases := Ncases + FObs; + end; + end; + if (InputGroup.ItemIndex = 2) then // get no. of cases and proportions for each cell + begin + Ncases := StrToInt(NCasesEdit.Text); + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + Row := round(StrToFloat(OS3MainFrm.DataGrid.Cells[RowNo,i])); + Col := round(StrToFloat(OS3MainFrm.DataGrid.Cells[ColNo,i])); + Row := Row - MinRow + 1; + Col := Col - MinCol + 1; + PObs := round(StrToFloat(OS3MainFrm.DataGrid.Cells[DepNo,i])); + Frq := round(PObs * Ncases); + Fval := PObs * Ncases; + if (Fval - Frq < 0.5) then Frq := round(Fval) + else Frq := ceil(Fval); + Freq[Row-1,Col-1] := Freq[Row-1,Col-1] + Frq; + end; + end; + Freq[Nrows,Ncols] := Ncases; + + // Now, calculate expected values + // Get row totals first + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + Freq[i-1,Ncols] := Freq[i-1,Ncols] + Freq[i-1,j-1]; + end; + end; + + // Get col totals next + for j := 1 to Ncols do + begin + for i := 1 to Nrows do + begin + Freq[Nrows,j-1] := Freq[Nrows,j-1] + Freq[i-1,j-1]; + end; + end; + + // Then get expected values and cell chi-squares + ChiSquare := 0.0; + Adjchisqr := 0.0; + if ((YatesChk.Checked) and (Nrows = 2) and (Ncols = 2)) then yates := true; + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + Expected[i-1,j-1] := Freq[Nrows,j-1] * Freq[i-1,Ncols] / Ncases; + if (Expected[i-1,j-1] > 0.0) then + CellChi[i-1,j-1] := sqr(Freq[i-1,j-1] - Expected[i-1,j-1]) / Expected[i-1,j-1] + else + begin + MessageDlg('Zero expected value found.', mtError, [mbOK], 0); + CellChi[i-1,j-1] := 0.0; + end; + ChiSquare := ChiSquare + CellChi[i-1,j-1]; + end; + end; + df := (Nrows - 1) * (Ncols - 1); + if (yates = true) then // 2 x 2 corrected chi-square + begin + Adjchisqr := abs((Freq[0,0] * Freq[1,1]) - (Freq[0,1] * Freq[1,0])); + Adjchisqr := sqr(Adjchisqr - Ncases / 2.0) * Ncases; // numerator + Adjchisqr := Adjchisqr / (Freq[0,2] * Freq[1,2] * Freq[2,0] * Freq[2,1]); + Adjprobchi := 1.0 - chisquaredprob(Adjchisqr,df); + end; + ProbChi := 1.0 - chisquaredprob(ChiSquare,df); // prob. larger chi + + //Print results to output form + lReport := TStringList.Create; + try + lReport.Add('CHI-SQUARE ANALYSIS RESULTS FOR ' + RaterAEdit.Text + ' AND ' + RaterBEdit.Text); + lReport.Add('No. of Cases = %d', [Ncases]); + lReport.Add(''); + + // print tables requested by use + if (ObsChk.Checked) then + begin + IntArrayPrint(Freq, Nrows+1, Ncols+1, 'Frequencies', + RowLabels, ColLabels, 'OBSERVED FREQUENCIES', lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + end; + + if (ExpChk.Checked) then + begin + outline := 'EXPECTED FREQUENCIES'; + MatPrint(Expected, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases, lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + end; + + if (PropChk.Checked) then + begin + outline := 'ROW PROPORTIONS'; + for i := 1 to Nrows + 1 do + begin + for j := 1 to Ncols do + begin + if (Freq[i-1,Ncols] > 0.0) then + Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[i-1,Ncols] + else + Prop[i-1,j-1] := 0.0; + end; + if (Freq[i-1,Ncols] > 0.0) then + Prop[i-1,Ncols] := 1.0 + else + Prop[i-1][Ncols] := 0.0; + end; + MatPrint(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases, lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + + outline := 'COLUMN PROPORTIONS'; + for j := 1 to Ncols + 1 do + begin + for i := 1 to Nrows do + begin + if (Freq[Nrows,j-1] > 0.0) then + Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[Nrows,j-1] + else + Prop[i-1,j-1] := 0.0; + end; + if (Freq[Nrows,j-1] > 0.0) then + Prop[Nrows][j-1] := 1.0 + else + Prop[Nrows,j-1] := 0.0; + end; + MatPrint(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases, lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + + outline := 'PROPORTIONS OF TOTAL N'; + for i := 1 to Nrows + 1 do + for j := 1 to Ncols + 1 do Prop[i-1,j-1] := Freq[i-1,j-1] / Ncases; + Prop[Nrows,Ncols] := 1.0; + MatPrint(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases, lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + end; + + if (ChiChk.Checked) then + begin + outline := 'CHI-SQUARED VALUE FOR CELLS'; + MatPrint(CellChi, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases, lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + end; + + lReport.Add(''); + lReport.Add('Chi-square: %.3f with D.F. %d. Prob. > value %.3f', [ChiSquare, df, ProbChi]); + lReport.Add(''); + + if yates then + lReport.Add('Chi-square using Yates correction %.3f and Prob > value %.3f', [Adjchisqr, Adjprobchi]); + + likelihood := 0.0; + for i := 0 to Nrows - 1 do + for j := 0 to Ncols - 1 do + likelihood := likelihood + Freq[i,j] * (ln(Expected[i,j] / Freq[i,j])); + likelihood := -2.0 * likelihood; + problikelihood := 1.0 - chisquaredprob(likelihood,df); + lReport.Add('Likelihood Ratio %.3f with prob. > value %.4f', [likelihood, problikelihood]); + lReport.Add(''); + + phi := sqrt(ChiSquare / Ncases); + lReport.Add('phi correlation: %.4f', [phi]); + lReport.Add(''); + + pearsonr := 0.0; + SumX := 0.0; + SumY := 0.0; + VarX := 0.0; + VarY := 0.0; + for i := 0 to Nrows - 1 do SumX := SumX + ( (i+1) * Freq[i,Ncols] ); + for j := 0 to Ncols - 1 do SumY := SumY + ( (j+1) * Freq[Nrows,j] ); + for i := 0 to Nrows - 1 do VarX := VarX + ( ((i+1)*(i+1)) * Freq[i,Ncols] ); + for j := 0 to Ncols - 1 do VarY := VarY + ( ((j+1)*(j+1)) * Freq[Nrows,j] ); + VarX := VarX - ((SumX * SumX) / Ncases); + VarY := VarY - ((SumY * SumY) / Ncases); + for i := 0 to Nrows - 1 do + for j := 0 to Ncols - 1 do + pearsonr := pearsonr + ((i+1)*(j+1) * Freq[i,j]); + pearsonr := pearsonr - (SumX * SumY / Ncases); + pearsonr := pearsonr / sqrt(VarX * VarY); + lReport.Add('Pearson Correlation r = %6.4f', [pearsonr]); + lReport.Add(''); + + MantelHaenszel := (Ncases-1) * (pearsonr * pearsonr); + MHprob := 1.0 - chisquaredprob(MantelHaenszel,1); + lReport.Add('Mantel-Haenszel Test of Linear Association: %.3f with probability > value = %.4f', [MantelHaenszel, MHprob]); + lReport.Add(''); + + CoefCont := sqrt(ChiSquare / (ChiSquare + Ncases)); + lReport.Add('The coefficient of contingency: %.3f', [CoefCont]); + lReport.Add(''); + + if (Nrows < Ncols) then + CramerV := sqrt(ChiSquare / (Ncases * ((Nrows-1)))) + else + CramerV := sqrt(ChiSquare / (Ncases * ((Ncols-1)))); + lReport.Add('Cramers V: %.3f', [CramerV]); + + // kappa + if (Nrows = Ncols) then + begin + obsdiag := 0.0; + expdiag := 0.0; + for i := 0 to Nrows - 1 do + begin + obsdiag := obsdiag + Freq[i,i]; + expdiag := expdiag + Expected[i,i]; + end; + expnondiag := Ncases - expdiag; + Kappa := (obsdiag - expdiag) / expnondiag; + lReport.Add(''); + lReport.Add('Unweighted Kappa: %.4f', [Kappa]); + + // get linear weights + SetLength(weights,Nrows,Ncols); + SetLength(quadweights,Nrows,Ncols); + for i := 0 to Nrows - 1 do + begin + for j := 0 to Ncols - 1 do + begin + weights[i,j] := 0.0; + quadweights[i,j] := 0.0; + end; + end; + for i := 0 to Nrows - 1 do + begin + for j := 0 to Ncols - 1 do + begin + weights[i,j] := 1.0 - (abs((i-j)) / (Nrows-1)); + quadweights[i,j] := 1.0 - ( abs((i-j)*(i-j)) / ((Nrows-1)*(Nrows-1)) ); + end; + end; + + outline := 'Observed Linear Weights'; + MatPrint(weights, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases, lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + + outline := 'Observed Quadratic Weights'; + MatPrint(quadweights, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases, lReport); + lReport.Add('------------------------------------------------------------------------------'); + lReport.Add(''); + + for i := 0 to Nrows - 1 do + begin + for j := 0 to Ncols - 1 do + begin + pobserved := pobserved + (Freq[i][j] / Ncases) * weights[i,j]; + pexpected := pexpected + (Expected[i,j] / Ncases) * weights[i,j]; + end; + end; + Kappa := (pobserved - pexpected) / (1.0 - pexpected); + lReport.Add('Linear Weighted Kappa: %.4f', [Kappa]); + + pobserved := 0.0; + pexpected := 0.0; + for i := 0 to Nrows - 1 do + begin + for j := 0 to Ncols - 1 do + begin + pobserved := pobserved + (Freq[i,j] / Ncases) * quadweights[i,j]; + pexpected := pexpected + (Expected[i,j] / Ncases) * quadweights[i,j]; + end; + end; + Kappa := (pobserved - pexpected) / (1.0 - pexpected); + lReport.Add('Quadratic Weighted Kappa: %.4f', [Kappa]); + quadweights := nil; + weights := nil; + end; + + DisplayReport(lReport); + finally + lReport.Free; + end; + + // save frequency data file if elected + if ((SaveChk.Checked) and (InputGroup.ItemIndex = 0)) then + begin + ClearGrid; + for i := 1 to 3 do DictionaryFrm.NewVar(i); + DictionaryFrm.DictGrid.Cells[1,1] := 'ROW'; + DictionaryFrm.DictGrid.Cells[1,2] := 'COL'; + DictionaryFrm.DictGrid.Cells[1,3] := 'FREQ.'; + OS3MainFrm.DataGrid.Cells[1,0] := 'ROW'; + OS3MainFrm.DataGrid.Cells[2,0] := 'COL'; + OS3MainFrm.DataGrid.Cells[3,0] := 'Freq.'; + k := 1; + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + OS3MainFrm.DataGrid.RowCount := k + 1; + OS3MainFrm.DataGrid.Cells[1,k] := IntToStr(i); + OS3MainFrm.DataGrid.Cells[2,k] := IntToStr(j); + OS3MainFrm.DataGrid.Cells[3,k] := IntToStr(Freq[i-1,j-1]); + k := k + 1; + end; + end; + for i := 1 to k - 1 do + begin + title := 'CASE ' + IntToStr(i); + OS3MainFrm.DataGrid.Cells[0,i] := title; + end; + title := InputBox('FILE:','File Name:','Frequencies.LAZ'); + OS3MainFrm.FileNameEdit.Text := title; + OS3MainFrm.NoVarsEdit.Text := IntToStr(3); + OS3MainFrm.NoCasesEdit.Text := IntToStr(k-1); + NoVariables := 3; + NoCases := k-1; + + SaveOS2File; + end; + + //clean up + ColLabels := nil; + RowLabels := nil; + CellChi := nil; + Expected := nil; + Prop := nil; + Freq := nil; + ColNoSelected := nil; +end; + +procedure TWeightedKappaFrm.DepInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepEdit.Text = '') then + begin + DepEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TWeightedKappaFrm.DepOutClick(Sender: TObject); +begin + if DepEdit.Text <> '' then + begin + VarList.Items.Add(DepEdit.Text); + DepEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TWeightedKappaFrm.UpdateBtnStates; +begin + RowIn.Enabled := (VarList.ItemIndex > -1) and (RaterAEdit.Text = ''); + RowOut.Enabled := (RaterAEdit.Text <> ''); + + ColIn.Enabled := (VarList.ItemIndex > -1) and (RaterBEdit.Text = ''); + ColOut.Enabled := (RaterBEdit.Text <> ''); + + DepIn.Enabled := (InputGroup.ItemIndex > 0) and (VarList.ItemIndex > -1) and (DepEdit.Text = ''); + DepOut.Enabled := (InputGroup.ItemIndex > 0) and (DepEdit.Text <> ''); + DepEdit.Enabled := (InputGroup.ItemIndex > 0); + DepLbl.Enabled := DepEdit.Enabled; + + NCasesEdit.Enabled := (InputGroup.ItemIndex = 2); + NCasesLbl.Enabled := NCasesEdit.Enabled; +end; + +procedure TWeightedKappaFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I kappaunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/kendalltauunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/kendalltauunit.lfm new file mode 100644 index 000000000..90fc80eb3 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/kendalltauunit.lfm @@ -0,0 +1,329 @@ +object KendallTauFrm: TKendallTauFrm + Left = 719 + Height = 379 + Top = 350 + Width = 396 + AutoSize = True + Caption = 'Kendall Rank Correlation Tau and Partial Tau' + ClientHeight = 379 + ClientWidth = 396 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables Available' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = XEdit + AnchorSideBottom.Control = XEdit + Left = 220 + Height = 15 + Top = 33 + Width = 51 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'X Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = YEdit + AnchorSideBottom.Control = YEdit + Left = 220 + Height = 15 + Top = 117 + Width = 51 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Y Variable' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = ZEdit + AnchorSideBottom.Control = ZEdit + Left = 220 + Height = 15 + Top = 201 + Width = 51 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Z Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = XIn + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 303 + Top = 25 + Width = 168 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object XIn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 184 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = XInClick + Spacing = 0 + TabOrder = 1 + end + object XOut: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = XIn + AnchorSideTop.Side = asrBottom + Left = 184 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = XOutClick + Spacing = 0 + TabOrder = 2 + end + object YIn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = XOut + AnchorSideTop.Side = asrBottom + Left = 184 + Height = 28 + Top = 109 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = YInClick + Spacing = 0 + TabOrder = 4 + end + object YOut: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = YIn + AnchorSideTop.Side = asrBottom + Left = 184 + Height = 28 + Top = 141 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = YOutClick + Spacing = 0 + TabOrder = 5 + end + object ZIn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = YOut + AnchorSideTop.Side = asrBottom + Left = 184 + Height = 28 + Top = 193 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ZInClick + Spacing = 0 + TabOrder = 7 + end + object ZOut: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ZIn + AnchorSideTop.Side = asrBottom + Left = 184 + Height = 28 + Top = 225 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ZOutClick + Spacing = 0 + TabOrder = 8 + end + object XEdit: TEdit + AnchorSideLeft.Control = XIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = XOut + AnchorSideBottom.Side = asrBottom + Left = 220 + Height = 23 + Top = 50 + Width = 168 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'XEdit' + end + object YEdit: TEdit + AnchorSideLeft.Control = YIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = YOut + AnchorSideBottom.Side = asrBottom + Left = 220 + Height = 23 + Top = 134 + Width = 168 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'Edit1' + end + object ZEdit: TEdit + AnchorSideLeft.Control = ZIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ZOut + AnchorSideBottom.Side = asrBottom + Left = 220 + Height = 23 + Top = 218 + Width = 168 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 9 + Text = 'Edit1' + end + object OptionsGroup: TGroupBox + AnchorSideLeft.Control = XEdit + AnchorSideTop.Control = ZOut + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 222 + Height = 45 + Top = 277 + Width = 150 + AutoSize = True + BorderSpacing.Left = 2 + BorderSpacing.Top = 24 + BorderSpacing.Bottom = 8 + Caption = 'Options:' + ClientHeight = 25 + ClientWidth = 146 + TabOrder = 10 + object RanksChk: TCheckBox + Left = 12 + Height = 19 + Top = 0 + Width = 128 + BorderSpacing.Left = 12 + BorderSpacing.Right = 6 + BorderSpacing.Bottom = 6 + Caption = 'Show Ranked Scores' + TabOrder = 0 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 187 + Height = 25 + Top = 346 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 32 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 11 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 249 + Height = 25 + Top = 346 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 12 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 333 + Height = 25 + Top = 346 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 13 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 330 + Width = 396 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/kendalltauunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/kendalltauunit.pas new file mode 100644 index 000000000..750215b37 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/kendalltauunit.pas @@ -0,0 +1,638 @@ +// Use file "taudata.laz" for testing. + +unit KendallTauUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, Globals, DataProcs, MatrixLib; + +type + + { TKendallTauFrm } + + TKendallTauFrm = class(TForm) + Bevel1: TBevel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + RanksChk: TCheckBox; + OptionsGroup: TGroupBox; + XEdit: TEdit; + YEdit: TEdit; + ZEdit: TEdit; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + XIn: TBitBtn; + XOut: TBitBtn; + YIn: TBitBtn; + YOut: TBitBtn; + ZIn: TBitBtn; + ZOut: TBitBtn; + Label1: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + procedure XInClick(Sender: TObject); + procedure XOutClick(Sender: TObject); + procedure YInClick(Sender: TObject); + procedure YOutClick(Sender: TObject); + procedure ZInClick(Sender: TObject); + procedure ZOutClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + KendallTauFrm: TKendallTauFrm; + +implementation + +uses + Math; + +{ TKendallTauFrm } + +procedure TKendallTauFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + XEdit.Text := ''; + YEdit.Text := ''; + ZEdit.Text := ''; + RanksChk.Checked := false; + VarList.Items.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TKendallTauFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TKendallTauFrm.XInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (XEdit.Text = '') then + begin + XEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TKendallTauFrm.XOutClick(Sender: TObject); +begin + if XEdit.Text <> '' then + begin + VarList.Items.Add(XEdit.Text); + XEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TKendallTauFrm.YInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (YEdit.Text = '') then + begin + YEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TKendallTauFrm.YOutClick(Sender: TObject); +begin + if YEdit.Text <> '' then + begin + VarList.Items.Add(YEdit.Text); + YEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TKendallTauFrm.ZInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (ZEdit.Text = '') then + begin + ZEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TKendallTauFrm.ZOutClick(Sender: TObject); +begin + if ZEdit.Text <> '' then + begin + VarList.Items.Add(YEdit.Text); + ZEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TKendallTauFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + VarList.Constraints.MinHeight := OptionsGroup.Top + OptionsGroup.Height - VarList.Top; + + Constraints.MinWidth := OptionsGroup.Width * 2 + XIn.Width + 4 * VarList.BorderSpacing.Left; + Constraints.MinHeight := Height; + + FAutoSized := True; +end; + +procedure TKendallTauFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TKendallTauFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TKendallTauFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, itemp, NoTies, NoSelected : integer; + col1, col2, col3, NCases : integer; + index : IntDyneMat; + Probability, Temp, TieSum, Avg, SumT: double; + z, denominator, stddev : double; + Ranks, X : DblDyneMat; + cellstring: string; + ColNoSelected : IntdyneVec; + ColLabels : StrDyneVec; + RowLabels : StrDyneVec; + TauXY, TauXZ, TauYZ : double; + Tx, Ty, Tz : double; + Term1, Term2 : double; + PartialTau : double; + title : string; + lReport: TStrings; +begin + if XEdit.Text = '' then + begin + MessageDlg('X variable not selected.', mtError, [mbOK], 0); + exit; + end; + if YEdit.Text = '' then + begin + MessageDlg('Y variable not selected.', mtError, [mbOK], 0); + exit; + end; + + // Allocate memory + SetLength(index,NoCases,3); + SetLength(Ranks,NoCases,3); + SetLength(X,NoCases,3); + SetLength(ColLabels,3); + SetLength(RowLabels,NoCases); + SetLength(ColNoSelected,NoVariables); + Tx := 0.0; + Ty := 0.0; + Tz := 0.0; + + // Get column numbers and labels of variables selected + NoSelected := 0; + for j := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[j,0]; + if cellstring = Xedit.Text then + begin + ColNoSelected[0] := j; + ColLabels[0] := cellstring; + NoSelected := NoSelected + 1; + end; + if cellstring = Yedit.Text then + begin + ColNoSelected[1] := j; + ColLabels[1] := cellstring; + NoSelected := NoSelected + 1; + end; + if cellstring = Zedit.Text then + begin + ColNoSelected[2] := j; + ColLabels[2] := cellstring; + NoSelected := NoSelected + 1; + end; + end; + + // Get scores + NCases := 0; + for i := 1 to NoCases do + begin + if ( not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + NCases := NCases + 1; + col1 := ColNoSelected[0]; + col2 := ColNoSelected[1]; + if NoSelected = 3 then col3 := ColNoSelected[2]; + X[NCases-1,0] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col1,i])); + Ranks[NCases-1,0] := X[NCases-1,0]; + X[NCases-1,1] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col2,i])); + Ranks[NCases-1,1] := X[NCases-1,1]; + if NoSelected = 3 then + begin + X[NCases-1,2] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col3,i])); + Ranks[NCases-1,2] := X[NCases-1,2]; + end; + index[NCases-1,0] := NCases; + index[NCases-1,1] := NCases; + if NoSelected = 3 then index[NCases-1,2] := NCases; + end; + + for i := 0 to NCases - 1 do RowLabels[i] := IntToStr(i+1); + // Rank the first variable (X) + for i := 0 to NCases - 2 do + begin + for j := i + 1 to NCases-1 do + begin + if (Ranks[i,0] > Ranks[j,0]) then // swap + begin + Temp := Ranks[i,0]; + Ranks[i,0] := Ranks[j,0]; + Ranks[j,0] := Temp; + itemp := index[i,0]; + index[i,0] := index[j,0]; + index[j,0] := itemp; + end; + end; + end; + + // Assign ranks + for i := 0 to NCases-1 do Ranks[i,0] := i+1; + + // Check for ties in each + i := 1; + while (i < NCases) do + begin + j := i+1; + TieSum := 0.0; + NoTies := 0; + while (j <= NCases) do + begin + if (X[j-1,0] > X[i-1,0]) then + Break; + if (X[j-1,0] = X[i-1,0]) then + begin + TieSum := TieSum + Ranks[j-1,0]; + NoTies := NoTies + 1; + end; + j := j + 1; + end; + + if (NoTies > 0) then // at least one tie found + begin + TieSum := TieSum + Ranks[i-1,0]; + NoTies := NoTies + 1; + Avg := TieSum / NoTies; + for j := i to i + NoTies - 1 do Ranks[j-1,0] := Avg; + i := i + (NoTies-1); + Tx := Tx + NoTies *(NoTies-1); + end; + i := i + 1; + end; + Tx := Tx / 2.0; + + // Repeat sort for second variable Y + for i := 0 to NCases - 2 do + begin + for j := i + 1 to NCases-1 do + begin + if (Ranks[i,1] > Ranks[j,1]) then // swap + begin + Temp := Ranks[i,1]; + Ranks[i,1] := Ranks[j,1]; + Ranks[j,1] := Temp; + itemp := index[i,1]; + index[i,1] := index[j,1]; + index[j,1] := itemp; + end; + end; + end; + + // Assign ranks + for i := 0 to NCases-1 do Ranks[i,1] := i+1; + + // Check for ties in each + i := 1; + while (i < NCases) do + begin + j := i+1; + TieSum := 0.0; + NoTies := 0; + while (j <= NoCases) do + begin + if (X[j-1,1] > X[i-1,1]) then + Break; + if (X[j-1,1] = X[i-1,1]) then + begin + TieSum := TieSum + Ranks[j-1,1]; + NoTies := NoTies + 1; + end; + j := j + 1; + end; + + if (NoTies > 0) then // at least one tie found + begin + TieSum := TieSum + Ranks[i-1,1]; + NoTies := NoTies + 1; + Avg := TieSum / NoTies; + for j := i to i + NoTies - 1 do Ranks[j-1,1] := Avg; + i := i + (NoTies-1); + Ty := Ty + NoTies * (NoTies - 1); + end; + i := i + 1; + end; + Ty := Ty / 2.0; + + // Repeat for z variable + if NoSelected > 2 then // z was entered + begin + for i := 0 to NCases - 2 do + begin + for j := i + 1 to NCases-1 do + begin + if (Ranks[i,2] > Ranks[j,2]) then // swap + begin + Temp := Ranks[i,2]; + Ranks[i,2] := Ranks[j,2]; + Ranks[j,2] := Temp; + itemp := index[i,2]; + index[i,2] := index[j,2]; + index[j,2] := itemp; + end; + end; + end; + + // Assign ranks + for i := 0 to NCases-1 do Ranks[i,2] := i+1; + + // Check for ties in each + i := 1; + while (i < NCases) do + begin + j := i+1; + TieSum := 0.0; + NoTies := 0; + while (j <= NoCases) do + begin + if (X[j-1,2] > X[i-1,2]) then + Break; + if (X[j-1,2] = X[i-1,2]) then + begin + TieSum := TieSum + Ranks[j-1,2]; + NoTies := NoTies + 1; + end; + j := j + 1; + end; + + if (NoTies > 0) then // at least one tie found + begin + TieSum := TieSum + Ranks[i-1,2]; + NoTies := NoTies + 1; + Avg := TieSum / NoTies; + for j := i to i + NoTies - 1 do Ranks[j-1,2] := Avg; + i := i + (NoTies-1); + Tz := Tz + NoTies * (NoTies - 1); + end; + i := i + 1; + end; + Tz := Tz / 2.0; + end; + + // Rearrange ranks into original score order + for k := 1 to 3 do + begin + for i := 1 to NCases - 1 do + begin + for j := i + 1 to NCases do + begin + if (index[i-1,k-1] > index[j-1,k-1]) then // swap + begin + itemp := index[i-1,k-1]; + index[i-1,k-1] := index[j-1,k-1]; + index[j-1,k-1] := itemp; + Temp := Ranks[i-1,k-1]; + Ranks[i-1,k-1] := Ranks[j-1,k-1]; + Ranks[j-1,k-1] := Temp; + end; + end; + end; + end; + + // compute Tau for X and Y + // sort on X and obtain SumT for Y ranks + SumT := 0.0; + for i := 0 to NCases - 2 do + begin + for j := i + 1 to NCases-1 do + begin + if (Ranks[i,0] > Ranks[j,0]) then // swap + begin + Temp := Ranks[i,0]; + Ranks[i,0] := Ranks[j,0]; + Ranks[j,0] := Temp; + Temp := Ranks[i,1]; + Ranks[i,1] := Ranks[j,1]; + Ranks[j,1] := Temp; + if NoSelected = 3 then + begin + Temp := Ranks[i,2]; + Ranks[i,2] := Ranks[j,2]; + Ranks[j,2] := Temp; + end; + itemp := index[i,0]; + index[i,0] := index[j,0]; + index[j,0] := itemp; + end; + end; + end; + for i := 0 to NCases - 2 do + for j := i + 1 to NCases - 1 do + if Ranks[i,1] < Ranks[j,1] then SumT := SumT + 1.0 + else if Ranks[i,1] > Ranks[j,1] then SumT := SumT - 1.0; + Term1 := sqrt((NCases * (NCases-1)) / 2.0 - Tx); + Term2 := sqrt((NCases * (Ncases-1)) / 2.0 - Ty); + denominator := Term1 * Term2; + TauXY := SumT / denominator; + + if NoSelected > 2 then // get tau values for partial + begin + // Get TauXZ + SumT := 0.0; + for i := 0 to NCases - 2 do + for j := i + 1 to NCases - 1 do + if Ranks[i,2] < Ranks[j,2] then SumT := SumT + 1.0 + else if Ranks[i,2] > Ranks[j,2] then SumT := SumT - 1.0; + Term1 := sqrt((NCases * (NCases-1)) / 2.0 - Tx); + Term2 := sqrt((NCases * (Ncases-1)) / 2.0 - Tz); + denominator := Term1 * Term2; + TauXZ := SumT / denominator; + + // get back to original order then sort on Y + for i := 0 to NCases - 2 do + begin + for j := i + 1 to NCases - 1 do + begin + if index[i,0] > index[j,0] then // swap + begin + Temp := Ranks[i,0]; + Ranks[i,0] := Ranks[j,0]; + Ranks[j,0] := temp; + Temp := Ranks[i,1]; + Ranks[i,1] := Ranks[j,1]; + Ranks[j,1] := Temp; + Temp := Ranks[i,2]; + Ranks[i,2] := Ranks[j,2]; + Ranks[j,2] := Temp; + itemp := index[i,0]; + index[i,0] := index[j,0]; + index[j,0] := itemp; + end; + end; + end; + + // Get TauYZ + for i := 0 to NCases - 2 do // sort on Y variable + begin + for j := i + 1 to NCases-1 do + begin + if (Ranks[i,1] > Ranks[j,1]) then // swap + begin + Temp := Ranks[i,1]; + Ranks[i,1] := Ranks[j,1]; + Ranks[j,1] := Temp; + Temp := Ranks[i,2]; + Ranks[i,2] := Ranks[j,2]; + Ranks[j,2] := Temp; + itemp := index[i,1]; + index[i,1] := index[j,1]; + index[j,1] := itemp; + end; + end; + end; + + SumT := 0.0; + for i := 0 to NCases - 2 do + for j := i + 1 to NCases - 1 do + if Ranks[i,2] < Ranks[j,2] then SumT := SumT + 1.0 + else if Ranks[i,2] > Ranks[j,2] then SumT := SumT - 1.0; + Term1 := sqrt((NCases * (NCases-1)) / 2.0 - Ty); + Term2 := sqrt((NCases * (Ncases-1)) / 2.0 - Tz); + denominator := Term1 * Term2; + TauYZ := SumT / denominator; + PartialTau := (TauXY - TauXZ * TauYZ) / + (sqrt(1.0 - sqr(TauXZ)) * sqrt(1.0 - sqr(TauYZ))); + end; + + lReport := TStringList.Create; + try + lReport.Add('Kendall Tau for File ' + OS3MainFrm.FileNameEdit.Text); + lReport.Add(''); + lReport.Add('Kendall Tau for Variables ' + ColLabels[0] + ' and ' + ColLabels[1]); + + // do significance tests + stddev := sqrt( (2.0 * ( 2.0 * NCases + 5)) / (9.0 * NCases * (NCases - 1.0))); + z := abs(TauXY / stddev); + probability := 1.0 - probz(z); + lReport.Add('Tau = %8.4f z = %8.3f probability > |z| = %4.3f', [TauXY, z, probability]); + if NoSelected > 2 then + begin + lReport.Add(''); + z := abs(TauXZ / stddev); + probability := 1.0 - probz(z); + lReport.Add('Kendall Tau for variables ' + ColLabels[0] + ' and ' + ColLabels[2]); + lReport.Add('Tau = %8.4f z = %8.3f probability > |z| = %4.3f', [TauXZ, z, probability]); + z := abs(TauYZ / stddev); + probability := 1.0 - probz(z); + lReport.Add(''); + lReport.Add('Kendall Tau for variables ' + ColLabels[1] + ' and ' + ColLabels[2]); + lReport.Add('Tau = %8.4f z = %8.3f probability > |z| = %4.3f', [TauYZ, z, probability]); + lReport.Add(''); + lReport.Add('Partial Tau = %8.4f', [PartialTau]); + end; + lReport.Add(''); + lReport.Add('NOTE: Probabilities are for large N (>10)'); + + // print data matrix if option is elected + if RanksChk.Checked then + begin + lReport.Add(''); + lReport.Add('-----------------------------------------------------------------'); + lReport.Add(''); + title := 'Ranks'; + if NoSelected = 2 then + MatPrint(Ranks, NCases, 2, title, RowLabels, ColLabels, NCases, lReport) + else + MatPrint(Ranks, NCases, 3, title, RowLabels, ColLabels, NCases, lReport); + end; + + DisplayReport(lReport); + finally + lReport.Free; + ColNoSelected := nil; + RowLabels := nil; + ColLabels := nil; + X := nil; + Ranks := nil; + index := nil; + end; +end; + +procedure TKendallTauFrm.UpdateBtnStates; +var + i: Integer; + lSelected: Boolean; +begin + lSelected := false; + for i:=0 to VarList.Items.Count-1 do + if VarList.Selected[i] then + begin + lSelected := true; + break; + end; + XIn.Enabled := lSelected and (XEdit.Text = ''); + YIn.Enabled := lSelected and (YEdit.Text = ''); + ZIn.Enabled := lSelected and (ZEdit.Text = ''); + XOut.Enabled := (XEdit.Text <> ''); + YOut.Enabled := (YEdit.Text <> ''); + ZOut.Enabled := (ZEdit.Text <> ''); +end; + +initialization + {$I kendalltauunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.lfm new file mode 100644 index 000000000..41b07695e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.lfm @@ -0,0 +1,286 @@ +object KWAnovaFrm: TKWAnovaFrm + Left = 518 + Height = 365 + Top = 283 + Width = 421 + AutoSize = True + Caption = 'Kruskal-Wallis One Way ANOVA on Ranks' + ClientHeight = 365 + ClientWidth = 421 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables Available' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = GrpEdit + AnchorSideBottom.Control = GrpEdit + Left = 232 + Height = 15 + Top = 33 + Width = 77 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Group Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = DepEdit + AnchorSideBottom.Control = DepEdit + Left = 232 + Height = 15 + Top = 125 + Width = 102 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GrpIn + AnchorSideBottom.Control = AlphaEdit + Left = 8 + Height = 260 + Top = 25 + Width = 180 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object GrpIn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 196 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = GrpInClick + Spacing = 0 + TabOrder = 1 + end + object GrpOut: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = GrpIn + AnchorSideTop.Side = asrBottom + Left = 196 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = GrpOutClick + Spacing = 0 + TabOrder = 2 + end + object DepIn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = GrpOut + AnchorSideTop.Side = asrBottom + Left = 196 + Height = 28 + Top = 117 + Width = 28 + BorderSpacing.Top = 32 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInClick + Spacing = 0 + TabOrder = 4 + end + object DepOut: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepIn + AnchorSideTop.Side = asrBottom + Left = 196 + Height = 28 + Top = 149 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutClick + Spacing = 0 + TabOrder = 5 + end + object GrpEdit: TEdit + AnchorSideLeft.Control = GrpIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GrpOut + AnchorSideBottom.Side = asrBottom + Left = 232 + Height = 23 + Top = 50 + Width = 181 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'GrpEdit' + end + object DepEdit: TEdit + AnchorSideLeft.Control = DepOut + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOut + AnchorSideBottom.Side = asrBottom + Left = 232 + Height = 23 + Top = 142 + Width = 181 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'DepEdit' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 208 + Height = 25 + Top = 332 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 9 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 270 + Height = 25 + Top = 332 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 10 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 354 + Height = 25 + Top = 332 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 11 + end + object MWUChk: TCheckBox + AnchorSideLeft.Control = DepEdit + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + Left = 232 + Height = 19 + Top = 226 + Width = 140 + BorderSpacing.Top = 2 + Caption = 'Mann-Whitney U Tests' + TabOrder = 7 + end + object Label4: TLabel + AnchorSideLeft.Control = DepEdit + AnchorSideTop.Control = DepOut + AnchorSideTop.Side = asrBottom + Left = 232 + Height = 15 + Top = 209 + Width = 161 + BorderSpacing.Top = 32 + Caption = 'Post Hoc Comparisons Option' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = AlphaEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = AlphaEdit + Left = 51 + Height = 15 + Top = 297 + Width = 45 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Alpha = ' + ParentColor = False + end + object AlphaEdit: TEdit + AnchorSideRight.Control = VarList + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 104 + Height = 23 + Top = 293 + Width = 84 + Alignment = taRightJustify + Anchors = [akLeft, akRight, akBottom] + TabOrder = 8 + Text = 'AlphaEdit' + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 316 + Width = 421 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.pas new file mode 100644 index 000000000..8057a0aa9 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/kwanovaunit.pas @@ -0,0 +1,562 @@ +// File for testing: "kwanova.laz" + +unit KWANOVAUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, Globals, DataProcs; + +type + + { TKWAnovaFrm } + + TKWAnovaFrm = class(TForm) + AlphaEdit: TEdit; + Bevel1: TBevel; + Label4: TLabel; + Label5: TLabel; + MWUChk: TCheckBox; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + GrpEdit: TEdit; + DepEdit: TEdit; + GrpIn: TBitBtn; + GrpOut: TBitBtn; + DepIn: TBitBtn; + DepOut: TBitBtn; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure DepInClick(Sender: TObject); + procedure DepOutClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure GrpInClick(Sender: TObject); + procedure GrpOutClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + KWAnovaFrm: TKWAnovaFrm; + +implementation + +uses + Math; + +{ TKWAnovaFrm } + +procedure TKWAnovaFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + GrpEdit.Text := ''; + DepEdit.Text := ''; + AlphaEdit.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL); + MWUChk.Checked := false; + VarList.Items.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TKWAnovaFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinHeight := MWUChk.Top + MWUChk.Height - VarList.Top; + + Constraints.MinWidth := Label4.Width * 2 + GrpIn.Width + 4* VarList.BorderSpacing.Left; + Constraints.MinHeight := Height; + + FAutoSized := True; +end; + +procedure TKWAnovaFrm.FormCreate(Sender: TObject); +begin + Assert(OS3Mainfrm <> nil); +end; + +procedure TKWAnovaFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TKWAnovaFrm.ComputeBtnClick(Sender: TObject); +label cleanup, Check1, Check2; +var + i, j, k, m, ind_var, dep_var, min_grp, max_grp, group, total_n : integer; + NoTies, NoTieGroups, nogroups, NoSelected, npairs, n1, n2 : integer; + largestn : integer; + ColNoSelected : IntdyneVec; + group_count : IntDyneVec; + score, t, SumT, Avg, Probchi, H, CorrectedH, value : double; + Correction, Temp, TieSum, alpha, U, U2, SD, z, prob : double; + Ranks, X : DblDyneMat; + RankSums : DblDyneVec; + cellstring, outline : string; + lReport: TStrings; +begin + // Check for data + if (NoVariables < 1) then + begin + MessageDlg('You must have grid data!', mtError, [mbOK], 0); + exit; + end; + + if GrpEdit.Text = '' then + begin + MessageDlg('Group variable not specified.', mtError, [mbOK], 0); + exit; + end; + + if DepEdit.Text = '' then + begin + MessageDlg('Dependent variable not selected.', mtError, [mbOK], 0); + exit; + end; + + if AlphaEdit.Text = '' then + begin + AlphaEdit.SetFocus; + MessageDlg('Alpha level not specified.', mtError, [mbOK], 0); + exit; + end; + if not TryStrToFloat(AlphaEdit.Text, alpha) or (alpha <= 0) or (alpha >= 1) then + begin + AlphaEdit.Setfocus; + MessageDlg('Alpha level must be a valid number between 0 and 1.', mtError, [mbOK], 0); + end; + + + // allocate space + SetLength(ColNoSelected,NoVariables); + SetLength(Ranks,NoCases,2); + SetLength(X,NoCases,2); + + // Get column numbers of the independent and dependent variables + ind_var := 0; + dep_var := 0; + for i := 1 to NoVariables do + begin + cellstring := GrpEdit.Text; + if (cellstring = OS3MainFrm.DataGrid.Cells[i,0]) then ind_var := i; + cellstring := DepEdit.Text; + if (cellstring = OS3MainFrm.DataGrid.Cells[i,0]) then dep_var := i; + end; + ColNoSelected[0] := ind_var; + ColNoSelected[1] := dep_var; + + //get minimum and maximum group codes + total_n := 0; + NoSelected := 2; + min_grp := 10000; //atoi(MainForm.Grid.Cells[ind_var,1].c_str); + max_grp := -10000; + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ind_var,i]))); + if (group < min_grp) then min_grp := group; + if (group > max_grp) then max_grp := group; + total_n := total_n + 1; + end; + nogroups := max_grp - min_grp + 1; + NoTieGroups := 0; + SumT := 0.0; + H := 0.0; + + // Initialize arrays + SetLength(RankSums,nogroups); + SetLength(group_count,nogroups); + for i := 0 to nogroups-1 do + begin + group_count[i] := 0; + RankSums[i] := 0.0; + end; + + // Setup for printer output + lReport := TStringList.Create; + try + lReport.Add('KRUSKAL-WALLIS ONE-WAY ANALYSIS OF VARIANCE'); + lReport.Add('See pages 184-194 in S. Siegel: Nonparametric Statistics for the Behavioral Sciences'); + lReport.Add(''); + + // Get data + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + score := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[dep_var,i])); + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ind_var,i]))); + group := group - min_grp + 1; + if (group > nogroups) then + begin + MessageDlg('Group codes must be sequential like 1 and 2!', mtError, [mbOk], 0); + exit; + end; + group_count[group-1] := group_count[group-1] + 1; + X[i-1,0] := score; + X[i-1,1] := group; + end; + + //Sort all scores in ascending order + for i := 1 to total_n - 1 do + begin + for j := i + 1 to total_n do + begin + if (X[i-1,0] > X[j-1,0]) then + begin + Temp := X[i-1,0]; + X[i-1,0] := X[j-1,0]; + X[j-1,0] := Temp; + Temp := X[i-1,1]; + X[i-1,1] := X[j-1,1]; + X[j-1,1] := Temp; + end; + end; + end; + + // Store ranks + for i := 0 to total_n-1 do + begin + Ranks[i,0] := i+1; + Ranks[i,1] := X[i,1]; + end; + + //Check for ties in ranks - replace with average rank and calculate + //T for each tie and sum of the T's + i := 1; + while i < total_n do + begin + j := i + 1; + TieSum := 0; + NoTies := 0; + while (j < total_n) do + begin + if (X[j-1,0] > X[i-1,0]) then + break; + if (X[j-1,0] = X[i-1,0]) then // match + begin + TieSum := TieSum + round(Ranks[j-1,0]); + NoTies := NoTies + 1; + end; + j := j + 1; + end; + + if (NoTies > 0) then //At least one tie found + begin + TieSum := TieSum + Ranks[i-1,0]; + NoTies := NoTies + 1; + Avg := TieSum / NoTies; + for j := i to i + NoTies - 1 do Ranks[j-1,0] := Avg; + t := Power(NoTies,3) - NoTies; + SumT := SumT + t; + NoTieGroups := NoTieGroups + 1; + i := i + (NoTies - 1); + end; + i := i + 1; + end; // next i + + // Calculate sum of ranks in each group + for i := 1 to total_n do + begin + group := round(Ranks[i-1,1]); + RankSums[group-1] := RankSums[group-1] + Ranks[i-1,0]; + end; + + // Calculate statistics + for j := 0 to nogroups-1 do H := H + (RankSums[j] * RankSums[j] / (group_count[j])); + H := H * (12.0 / ( total_n * (total_n + 1)) ); + H := H - (3.0 * (total_n + 1)); + Correction := 1.0 - ( SumT / (Power(total_n,3) - total_n) ); + CorrectedH := H / Correction; + k := max_grp - min_grp; + Probchi := 1.0 - chisquaredprob(H, k); + + // Report results + lReport.Add(' Score Rank Group'); + lReport.Add(''); + for i := 1 to total_n do + lReport.Add('%10.2f %10.2f %10.0f', [X[i-1,0], Ranks[i-1,0], Ranks[i-1,1]]); + lReport.Add(''); + lReport.Add('Sum of Ranks in each Group'); + lReport.Add('Group Sum No. in Group'); + for i := 1 to nogroups do + lReport.Add('%3d %10.2f %5d', [i+min_grp-1, RankSums[i-1], group_count[i-1]]); + lReport.Add(''); + lReport.Add('No. of tied rank groups = %3d', [NoTieGroups]); + lReport.Add('Statistic H uncorrected for ties: %8.4f', [H]); + lReport.Add('Correction for Ties: %8.4f', [Correction]); + lReport.Add('Statistic H corrected for ties: %8.4f', [CorrectedH]); + lReport.Add('Corrected H is approx. chi-square with %d D.F. and probability %.4f', [k, Probchi]); + + if MWUChk.Checked then + begin + lReport.Add(''); + lReport.Add('------------------------------------------------------------------------'); + lReport.Add(''); + // do Mann-Whitney U tests on group pairs + alpha := StrToFloat(AlphaEdit.Text); + npairs := nogroups * (nogroups - 1) div 2; + alpha := alpha / npairs; + lReport.Add('New alpha for %d paired comparisons: %.3f', [npairs, alpha]); + for i := 1 to nogroups - 1 do + begin + for j := i + 1 to nogroups do + begin + // Setup for printer output + lReport.Add(''); + lReport.Add(''); + lReport.Add('MANN-WHITNEY U TEST'); + lReport.Add('See pages 116-127 in S. Siegel: Nonparametric Statistics for the Behavioral Sciences'); + lReport.Add(''); + lReport.Add('Comparison of group %d with group %d', [i, j]); + + group_count[0] := 0; + group_count[1] := 0; + RankSums[0] := 0; + RankSums[1] := 0; + total_n := 0; + for k := 1 to NoCases do + begin + if (not GoodRecord(k,NoSelected,ColNoSelected)) then continue; + score := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[dep_var,k])); + value := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ind_var,k])); + if round(value) = i then + begin + X[total_n,0] := score; + X[total_n,1] := value; + group_count[0] := group_count[0] + 1; + total_n := total_n + 1; + end; + if round(value) = j then + begin + X[total_n,0] := score; + X[total_n,1] := value; + group_count[1] := group_count[1] + 1; + total_n := total_n + 1; + end; + end; // next case k + + //Sort all scores in ascending order + for k := 1 to total_n - 1 do + begin + for m := k + 1 to total_n do + begin + if (X[k-1,0] > X[m-1,0]) then + begin + Temp := X[k-1,0]; + X[k-1,0] := X[m-1,0]; + X[m-1,0] := Temp; + Temp := X[k-1,1]; + X[k-1,1] := X[m-1,1]; + X[m-1,1] := Temp; + end; + end; + end; + + // get ranks for these two groups + for k := 1 to total_n do + begin + Ranks[k-1,0] := k; + Ranks[k-1,1] := X[k-1,1]; + end; + + //Check for ties in ranks - replace with average rank and calculate + //T for each tie and sum of the T's + NoTieGroups := 0; + k := 1; + while k < total_n do + begin + m := k + 1; + TieSum := 0; + NoTies := 0; + while (m < total_n) do + begin + if (X[m-1,0] > X[k-1,0]) then + Break; + if (X[m-1,0] = X[k-1,0]) then // match + begin + TieSum := TieSum + round(Ranks[m-1,0]); + NoTies := NoTies + 1; + end; + m := m + 1; + end; + if (NoTies > 0) then //At least one tie found + begin + TieSum := TieSum + Ranks[k-1,0]; + NoTies := NoTies + 1; + Avg := TieSum / NoTies; + for m := k to k + NoTies - 1 do Ranks[m-1,0] := Avg; + t := Power(NoTies,3) - NoTies; + SumT := SumT + t; + NoTieGroups := NoTieGroups + 1; + k := k + (NoTies - 1); + end; + k := k + 1; + end; // next k + + // Calculate sum of ranks in each group + for k := 1 to total_n do + begin + group := round(Ranks[k-1,1]); + RankSums[group-1] := RankSums[group-1] + Ranks[k-1,0]; + end; + + //Calculate U for larger and smaller groups + n1 := group_count[0]; + n2 := group_count[1]; + if (n1 > n2) then + begin + group := i-1; + U := (n1 * n2) + ((n1 * (n1 + 1)) / 2.0) - RankSums[group]; + end + else + begin + group := j - 1; + U := (n1 * n2) + ((n2 * (n2 + 1)) / 2.0) - RankSums[group]; + end; + U2 := (n1 * n2) - U; + SD := (n1 * n2 * (n1 + n2 + 1)) / 12.0; + SD := sqrt(SD); + if (U2 > U) then z := (U2 - (n1 * n2 / 2)) / SD + else z := (U - (n1 * n2 / 2)) / SD; + prob := 1.0 - probz(z); + + //Report results + lReport.Add(' Score Rank Group'); + lReport.Add(''); + for k := 1 to total_n do + lReport.Add('%10.2f %10.2f %10.0f', [X[k-1,0], Ranks[k-1,0], Ranks[k-1,1]]); + lReport.Add(''); + lReport.Add('Sum of Ranks in each Group'); + lReport.Add('Group Sum No. in Group'); + group := i - 1; + lReport.Add('%3d %10.3f %5d', [i, RankSums[group], group_count[0]]); + group := j - 1; + lReport.Add('%3d %10.3f %5d', [j, RankSums[group], group_count[1]]); + lReport.Add(''); + lReport.Add( 'No. of tied rank groups: %8d', [NoTieGroups]); + lReport.Add(outline); + if (n1 > n2) then largestn := n1 else largestn := n2; + if (largestn < 20) then + outline := Format( 'Statistic U: %8.4f',[U]) + else + begin + if (U > U2) then + outline := Format('Statistic U: %8.4f',[U]) + else + outline := Format('Statistic U: %8.4f',[U2]); + end; + lReport.Add(outline); + lReport.Add( 'z Statistic (corrected for ties): %8.4f', [z]); + lReport.Add( 'Prob. > z: %8.4f', [prob]); + if (n2 < 20) then + begin + lReport.Add('z test is approximate. Use tables of exact probabilities in Siegel.'); + lReport.Add('(Table J or K, pages 271-277)'); + end; + end; // next group j + end; // next group i + end; + + if lReport.Count > 0 then + DisplayReport(lReport); + + finally + lReport.Free; + group_count := nil; + RankSums := nil; + X := nil; + Ranks := nil; + ColNoSelected := nil; + end; +end; + +procedure TKWAnovaFrm.DepInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepEdit.Text = '') then + begin + DepEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TKWAnovaFrm.DepOutClick(Sender: TObject); +begin + if DepEdit.Text <> '' then + begin + VarList.Items.Add(DepEdit.Text); + DepEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TKWAnovaFrm.GrpInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (GrpEdit.Text = '') then + begin + GrpEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TKWAnovaFrm.GrpOutClick(Sender: TObject); +begin + if GrpEdit.Text <> '' then + begin + VarList.Items.Add(GrpEdit.Text); + GrpEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TKWAnovaFrm.UpdateBtnStates; +begin + GrpIn.Enabled := (VarList.Items.Count > 0) and (GrpEdit.Text = ''); + DepIn.Enabled := (VarList.Items.Count > 0) and (DepEdit.Text = ''); + GrpOut.Enabled := (GrpEdit.Text <> ''); + DepOut.Enabled := (DepEdit.Text <> ''); +end; + +procedure TKWAnovaFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I kwanovaunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/lifetableunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/lifetableunit.lfm new file mode 100644 index 000000000..893d2dadd --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/lifetableunit.lfm @@ -0,0 +1,540 @@ +object LifeTableForm: TLifeTableForm + Left = 496 + Height = 590 + Top = 122 + Width = 818 + AutoSize = True + Caption = 'Life Table' + ClientHeight = 590 + ClientWidth = 818 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Grid: TStringGrid + Left = 379 + Height = 420 + Top = 121 + Width = 500 + Align = alClient + BorderSpacing.Left = 2 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + ColCount = 13 + Constraints.MinWidth = 500 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goThumbTracking, goSmoothScroll] + RowCount = 2 + TabOrder = 2 + end + object Panel1: TPanel + Left = 8 + Height = 420 + Top = 121 + Width = 363 + Align = alLeft + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 2 + BevelOuter = bvNone + ClientHeight = 420 + ClientWidth = 363 + Constraints.MinWidth = 300 + TabOrder = 1 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 49 + Caption = 'Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ObsStartInBtn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 403 + Top = 17 + Width = 159 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object ObsStartInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 167 + Height = 28 + Top = 19 + Width = 28 + BorderSpacing.Top = 2 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ObsStartInBtnClick + Spacing = 0 + TabOrder = 1 + end + object ObsStartOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ObsStartInBtn + AnchorSideTop.Side = asrBottom + Left = 167 + Height = 28 + Top = 51 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ObsStartOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object Label2: TLabel + AnchorSideLeft.Control = ObsStartInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = ObsStartEdit + Left = 203 + Height = 15 + Top = 27 + Width = 91 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Observation Start' + ParentColor = False + end + object ObsStartEdit: TEdit + AnchorSideLeft.Control = ObsStartInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ObsStartOutBtn + AnchorSideBottom.Side = asrBottom + Left = 203 + Height = 23 + Top = 44 + Width = 160 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + Constraints.MinWidth = 150 + ReadOnly = True + TabOrder = 3 + Text = 'ObsStartEdit' + end + object Label3: TLabel + AnchorSideLeft.Control = ObsEndEdit + AnchorSideBottom.Control = ObsEndEdit + Left = 203 + Height = 15 + Top = 111 + Width = 90 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Observation End:' + ParentColor = False + end + object ObsEndEdit: TEdit + AnchorSideLeft.Control = ObsEndInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ObsEndOutBtn + AnchorSideBottom.Side = asrBottom + Left = 203 + Height = 23 + Top = 128 + Width = 160 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'ObsEndEdit' + end + object ObsEndInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ObsStartOutBtn + AnchorSideTop.Side = asrBottom + Left = 167 + Height = 28 + Top = 103 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ObsEndInBtnClick + Spacing = 0 + TabOrder = 4 + end + object ObsEndOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ObsEndInBtn + AnchorSideTop.Side = asrBottom + Left = 167 + Height = 28 + Top = 135 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ObsEndOutBtnClick + Spacing = 0 + TabOrder = 5 + end + object Label4: TLabel + AnchorSideLeft.Control = NoAliveEdit + AnchorSideBottom.Control = NoAliveEdit + Left = 203 + Height = 15 + Top = 195 + Width = 76 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Number Alive:' + ParentColor = False + end + object NoAliveEdit: TEdit + AnchorSideLeft.Control = AliveInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = AliveOutBtn + AnchorSideBottom.Side = asrBottom + Left = 203 + Height = 23 + Top = 212 + Width = 160 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 9 + Text = 'NoAliveEdit' + end + object AliveInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ObsEndOutBtn + AnchorSideTop.Side = asrBottom + Left = 167 + Height = 28 + Top = 187 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = AliveInBtnClick + Spacing = 0 + TabOrder = 7 + end + object AliveOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = AliveInBtn + AnchorSideTop.Side = asrBottom + Left = 167 + Height = 28 + Top = 219 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = AliveOutBtnClick + Spacing = 0 + TabOrder = 8 + end + object Label5: TLabel + AnchorSideLeft.Control = NoDiedEdit + AnchorSideBottom.Control = NoDiedEdit + Left = 203 + Height = 15 + Top = 279 + Width = 74 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Number Died:' + ParentColor = False + end + object NoDiedEdit: TEdit + AnchorSideLeft.Control = NoDiedOutBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = NoDiedOutBtn + AnchorSideBottom.Side = asrBottom + Left = 203 + Height = 23 + Top = 296 + Width = 160 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 12 + Text = 'NoDiedEdit' + end + object NoDiedInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = AliveOutBtn + AnchorSideTop.Side = asrBottom + Left = 167 + Height = 28 + Top = 271 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = NoDiedInBtnClick + Spacing = 0 + TabOrder = 10 + end + object NoDiedOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = NoDiedInBtn + AnchorSideTop.Side = asrBottom + Left = 167 + Height = 28 + Top = 303 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = NoDiedOutBtnClick + Spacing = 0 + TabOrder = 11 + end + object Label6: TLabel + AnchorSideLeft.Control = NoCensoredEdit + AnchorSideBottom.Control = NoCensoredEdit + Left = 203 + Height = 15 + Top = 363 + Width = 100 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Number Censored:' + ParentColor = False + end + object NoCensoredEdit: TEdit + AnchorSideLeft.Control = NoCensoredOutBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = NoCensoredOutBtn + AnchorSideBottom.Side = asrBottom + Left = 203 + Height = 23 + Top = 380 + Width = 160 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 15 + Text = 'NoCensoredEdit' + end + object NoCensoredInBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = NoDiedOutBtn + AnchorSideTop.Side = asrBottom + Left = 167 + Height = 28 + Top = 355 + Width = 28 + BorderSpacing.Top = 24 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = NoCensoredInBtnClick + Spacing = 0 + TabOrder = 13 + end + object NoCensoredOutBtn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = NoCensoredInBtn + AnchorSideTop.Side = asrBottom + Left = 167 + Height = 28 + Hint = '0' + Top = 387 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = NoCensoredOutBtnClick + Spacing = 0 + TabOrder = 14 + end + end + object Panel2: TPanel + Left = 0 + Height = 41 + Top = 549 + Width = 818 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + ClientHeight = 41 + ClientWidth = 818 + TabOrder = 3 + object ResetBtn: TButton + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Side = asrCenter + Left = 609 + Height = 25 + Top = 8 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Side = asrCenter + Left = 671 + Height = 25 + Top = 8 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object CloseBtn: TButton + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrCenter + Left = 755 + Height = 25 + Top = 8 + Width = 55 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 3 + end + object HelpBtn: TButton + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = ResetBtn + Left = 550 + Height = 25 + Top = 8 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 0 + end + end + object Panel3: TPanel + Left = 0 + Height = 113 + Top = 0 + Width = 818 + Align = alTop + AutoSize = True + BevelOuter = bvNone + ClientHeight = 113 + ClientWidth = 818 + TabOrder = 0 + object Memo1: TLabel + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = Panel3 + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 105 + Top = 8 + Width = 427 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Directions: Your input grid data should consist of five integer column vaiables:'#13#10'1. The beginning of each observation period (typically 0 for the first observation.'#13#10'2. The ending of each observation period.'#13#10'3. The number alive in the observation period.'#13#10'4. The number that died during the observation period.'#13#10'5. The number last seen alive during the period that are lost (censored)'#13#10'See the example file "lifetable.laz".' + ParentColor = False + WordWrap = True + end + object Label7: TLabel + AnchorSideTop.Control = CIEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = CIEdit + Left = 576 + Height = 15 + Top = 94 + Width = 188 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Confidence Level for Number Alive:' + ParentColor = False + end + object CIEdit: TEdit + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Memo1 + AnchorSideBottom.Side = asrBottom + Left = 772 + Height = 23 + Top = 90 + Width = 38 + Anchors = [akRight, akBottom] + BorderSpacing.Right = 8 + TabOrder = 0 + Text = '0.95' + end + end + object Splitter1: TSplitter + Left = 373 + Height = 428 + Top = 113 + Width = 4 + end + object Bevel1: TBevel + Left = 0 + Height = 8 + Top = 541 + Width = 818 + Align = alBottom + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/lifetableunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/lifetableunit.pas new file mode 100644 index 000000000..76df1f64d --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/lifetableunit.pas @@ -0,0 +1,403 @@ +unit LifeTableUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, Grids, + MainUnit, Globals, FunctionsLib, OutputUnit, + GraphLib, ContextHelpUnit; + +type + + { TLifeTableForm } + + TLifeTableForm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + CIEdit: TEdit; + Label7: TLabel; + Memo1: TLabel; + NoCensoredEdit: TEdit; + Label6: TLabel; + NoDiedEdit: TEdit; + Label5: TLabel; + NoAliveEdit: TEdit; + Label4: TLabel; + ObsEndEdit: TEdit; + Label3: TLabel; + ObsStartEdit: TEdit; + Label2: TLabel; + ObsStartInBtn: TBitBtn; + ObsEndInBtn: TBitBtn; + AliveInBtn: TBitBtn; + NoDiedInBtn: TBitBtn; + NoCensoredInBtn: TBitBtn; + ObsStartOutBtn: TBitBtn; + ObsEndOutBtn: TBitBtn; + AliveOutBtn: TBitBtn; + NoDiedOutBtn: TBitBtn; + NoCensoredOutBtn: TBitBtn; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + Label1: TLabel; + Grid: TStringGrid; + Splitter1: TSplitter; + VarList: TListBox; + procedure AliveInBtnClick(Sender: TObject); + procedure AliveOutBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure NoCensoredInBtnClick(Sender: TObject); + procedure NoCensoredOutBtnClick(Sender: TObject); + procedure NoDiedInBtnClick(Sender: TObject); + procedure NoDiedOutBtnClick(Sender: TObject); + procedure ObsEndInBtnClick(Sender: TObject); + procedure ObsEndOutBtnClick(Sender: TObject); + procedure ObsStartInBtnClick(Sender: TObject); + procedure ObsStartOutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + + public + { public declarations } + end; + +var + LifeTableForm: TLifeTableForm; + +implementation + +uses + Math; + +{ TLifeTableForm } + +procedure TLifeTableForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := True; +end; + +procedure TLifeTableForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + CIEdit.Text := FormatFloat('0.00', DEFAULT_CONFIDENCE_LEVEL_PERCENT * 0.01); +end; + +procedure TLifeTableForm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TLifeTableForm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TLifeTableForm.NoCensoredInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (NoCensoredEdit.Text = '') then + begin + NoCensoredEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TLifeTableForm.NoCensoredOutBtnClick(Sender: TObject); +begin + if NoCensoredEdit.Text <> '' then + begin + VarList.Items.Add(NoCensoredEdit.Text); + NoCensoredEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TLifeTableForm.NoDiedInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (NoDiedEdit.Text = '') then + begin + NoDiedEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TLifeTableForm.NoDiedOutBtnClick(Sender: TObject); +begin + if NoDiedEdit.Text <> '' then + begin + VarList.Items.Add(NoDiedEdit.Text); + NoDiedEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TLifeTableForm.AliveInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (NoAliveEdit.Text = '') then + begin + NoAliveEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TLifeTableForm.AliveOutBtnClick(Sender: TObject); +begin + if NoAliveEdit.Text <> '' then + begin + VarList.Items.Add(NoAliveEdit.Text); + NoAliveEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TLifeTableForm.ComputeBtnClick(Sender: TObject); +var + i : integer; + varcols : IntDyneVec; + AtRisk, ProbDie, CumProbLive, StdErr, Up95, Low95 : double; + N, P, Q, mu, CI, z : double; + outline : string; +begin + if ObsStartEdit.Text = '' then + begin + MessageDlg('Observation Start not specified.', mtError, [mbOK], 0); + exit; + end; + + if ObsEndEdit.Text = '' then + begin + MessageDlg('Observation End not specified.', mtError, [mbOK], 0); + exit; + end; + + if NoAliveEdit.Text = '' then + begin + MessageDlg('Number Alive not specified.', mtError, [mbOK], 0); + exit; + end; + + if NoDiedEdit.Text = '' then + begin + MessageDlg('Number Died not specified.', mtError, [mbOK], 0); + exit; + end; + + if NoCensoredEdit.Text = '' then + begin + MessageDlg('Number Censored not specified.', mtError, [mbOK], 0); + exit; + end; + + CI := StrToFloat(CIEdit.Text); + z := InverseZ(CI); + SetLength(varcols, 5); + for i := 1 to 5 do + begin + if (OS3MainFrm.DataGrid.Cells[i,0] = ObsStartEdit.Text) then varcols[0] := i; + if (OS3MainFrm.DataGrid.Cells[i,0] = ObsEndEdit.Text) then varcols[1] := i; + if (OS3MainFrm.DataGrid.Cells[i,0] = NoAliveEdit.Text) then varcols[2] := i; + if (OS3MainFrm.DataGrid.Cells[i,0] = NoDiedEdit.Text) then varcols[3] := i; + if (OS3MainFrm.DataGrid.Cells[i,0] = NoCensoredEdit.Text) then varcols[4] := i; + end; + + for i := 1 to NoCases do + begin + Grid.Cells[0,i] := 'CASE ' + IntToStr(i); + Grid.Cells[1,i] := Trim(OS3MainFrm.DataGrid.Cells[varcols[0],i]); + Grid.Cells[2,i] := Trim(OS3MainFrm.DataGrid.Cells[varcols[1],i]); + Grid.Cells[3,i] := Trim(OS3MainFrm.DataGrid.Cells[varcols[2],i]); + Grid.Cells[4,i] := Trim(OS3MainFrm.DataGrid.Cells[varcols[3],i]); + Grid.Cells[5,i] := Trim(OS3MainFrm.DataGrid.Cells[varcols[4],i]); + end; + for i := 1 to NoCases do + begin + AtRisk := StrToFloat(Grid.Cells[3,i]); + AtRisk := AtRisk - (StrToFloat(Grid.Cells[5,i]) / 2.0); + Grid.Cells[6,i] := Format('%.4f', [AtRisk]); + ProbDie := StrToFloat(Grid.Cells[4,i]) / AtRisk; + Grid.Cells[7,i] := Format('%.4f', [ProbDie]); + Grid.Cells[8,i] := Format('%.4f', [1.0-ProbDie]); + end; + + N := StrToFloat(Grid.Cells[3,1]); + Grid.Cells[9,1] := Grid.Cells[8,1]; + + P := StrToFloat(Grid.Cells[9,1]); + Q := 1.0 - P; + StdErr := sqrt(N * P * Q); + Grid.Cells[10,1] := format('%.4f', [StdErr]); + + mu := N * P; + Grid.Cells[10,1] := Format('%.4f', [StdErr]); + + Up95 := mu + z * StdErr; + Low95 := mu - z * StdErr; + Grid.Cells[11,1] := Format('%.4f', [Low95]); + Grid.Cells[12,1] := Format('%.4f', [Up95]); + + for i := 2 to NoCases do + begin + CumProbLive := StrToFloat(Grid.Cells[9,i-1]) * StrToFloat(Grid.Cells[8,i]); + Grid.Cells[9,i] := Format('%.4f', [CumProbLive]); + P := CumProbLive; + Q := 1.0 - P; + StdErr := sqrt(N * P * Q); + mu := N * P; + Grid.Cells[10,i] := Format('%.4f', [StdErr]); + Up95 := mu + z * StdErr; + Low95 := mu - z * StdErr; + Grid.Cells[11,i] := Format('%.4f', [Low95]); + Grid.Cells[12,i] := Format('%.4f', [Up95]); + end; + varcols := nil; +end; + +procedure TLifeTableForm.ObsEndInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (OBsEndEdit.Text = '') then + begin + ObsEndEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TLifeTableForm.ObsEndOutBtnClick(Sender: TObject); +begin + if ObsEndEdit.Text <> '' then + begin + VarList.Items.Add(ObsEndEdit.Text); + ObsEndEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TLifeTableForm.ObsStartInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (ObsStartEdit.Text = '') then + begin + ObsStartEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TLifeTableForm.ObsStartOutBtnClick(Sender: TObject); +begin + if ObsStartEdit.Text <> '' then + begin + VarList.Items.Add(ObsStartEdit.Text); + ObsStartEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TLifeTableForm.ResetBtnClick(Sender: TObject); + +VAR i : integer; + j : integer; +begin +// outline := format('NoCases = %d',[NoCases]); +// ShowMessage(outline); +// outline := format('No.Variables = %d',[NoVariables]); +// ShowMessage(outline); + VarList.Clear; + ObsStartEdit.Text := ''; + ObsEndEdit.Text := ''; + NoAliveEdit.Text := ''; + NoDiedEdit.Text := ''; + NoCensoredEdit.Text := ''; + Grid.RowCount := NoCases+1; + Grid.ColCount := 13; + Grid.Cells[1,0] := 'Obs.Start'; + Grid.Cells[2,0] := 'Obs.End'; + Grid.Cells[3,0] := 'Alive'; + Grid.Cells[4,0] := 'Died'; + Grid.Cells[5,0] := 'Censored'; + Grid.Cells[6,0] := 'At Risk'; + Grid.Cells[7,0] := 'Prob.Die'; + Grid.Cells[8,0] := 'Prob.Alive'; + Grid.Cells[9,0] := 'Cum.P.Alive'; + Grid.Cells[10,0] := 'S.E. Alive'; + Grid.Cells[11,0] := 'Low 95%'; + Grid.Cells[12,0] := 'Hi 95%'; + for i := 0 to 12 do + for j := 1 to NoCases do Grid.Cells[i,j] := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TLifeTableForm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TLifeTableForm.UpdateBtnStates; +begin + ObsStartInBtn.Enabled := (VarList.ItemIndex > -1) and (ObsStartEdit.Text = ''); + ObsEndInBtn.Enabled := (VarList.ItemIndex > -1) and (ObsEndEdit.Text = ''); + AliveInBtn.Enabled := (VarList.ItemIndex > -1) and (NoAliveEdit.Text = ''); + NoDiedInBtn.Enabled := (VarList.itemIndex > -1) and (NoDiedEdit.Text = ''); + NoCensoredInBtn.Enabled := (VarList.ItemIndex > -1) and (NoCensoredEdit.Text = ''); + + ObsStartOutBtn.Enabled := (ObsStartEdit.Text <> ''); + ObsEndOutBtn.Enabled := (ObsEndEdit.Text > ''); + AliveOutBtn.Enabled := (NoAliveEdit.Text <> ''); + NoDiedOutBtn.Enabled := (NoDiedEdit.Text <> ''); + NoCensoredOutBtn.Enabled := (NoCensoredEdit.Text > ''); +end; + +initialization + {$I lifetableunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/mannwhituunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/mannwhituunit.lfm new file mode 100644 index 000000000..e6405907d --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/mannwhituunit.lfm @@ -0,0 +1,247 @@ +object MannWhitUFrm: TMannWhitUFrm + Left = 540 + Height = 321 + Top = 256 + Width = 373 + AutoSize = True + Caption = 'Mann-Whitney U Test' + ClientHeight = 321 + ClientWidth = 373 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables Available' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = GrpEdit + AnchorSideBottom.Control = GrpEdit + Left = 245 + Height = 15 + Top = 33 + Width = 77 + Anchors = [akLeft, akBottom] + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 2 + Caption = 'Group Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = DepEdit + AnchorSideBottom.Control = DepEdit + Left = 245 + Height = 15 + Top = 125 + Width = 102 + Anchors = [akLeft, akBottom] + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GrpIn + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 247 + Top = 25 + Width = 193 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object GrpIn: TBitBtn + AnchorSideLeft.Control = Bevel3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + Left = 209 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = GrpInClick + Spacing = 0 + TabOrder = 1 + end + object GrpOut: TBitBtn + AnchorSideLeft.Control = Bevel3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GrpIn + AnchorSideTop.Side = asrBottom + Left = 209 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = GrpOutClick + Spacing = 0 + TabOrder = 2 + end + object DepIn: TBitBtn + AnchorSideLeft.Control = Bevel3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GrpOut + AnchorSideTop.Side = asrBottom + Left = 209 + Height = 28 + Top = 117 + Width = 28 + BorderSpacing.Top = 32 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInClick + Spacing = 0 + TabOrder = 3 + end + object DepOut: TBitBtn + AnchorSideLeft.Control = Bevel3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = DepIn + AnchorSideTop.Side = asrBottom + Left = 209 + Height = 28 + Top = 149 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutClick + Spacing = 0 + TabOrder = 4 + end + object GrpEdit: TEdit + AnchorSideLeft.Control = GrpIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GrpOut + AnchorSideBottom.Side = asrBottom + Left = 245 + Height = 23 + Top = 50 + Width = 120 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 5 + Text = 'GrpEdit' + end + object DepEdit: TEdit + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOut + AnchorSideBottom.Side = asrBottom + Left = 245 + Height = 23 + Top = 142 + Width = 120 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'Edit1' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 164 + Height = 25 + Top = 288 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 7 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 226 + Height = 25 + Top = 288 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 8 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 310 + Height = 25 + Top = 288 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 9 + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 272 + Width = 373 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Bevel3: TBevel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 163 + Height = 11 + Top = 7 + Width = 46 + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/mannwhituunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/mannwhituunit.pas new file mode 100644 index 000000000..d45801b6c --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/mannwhituunit.pas @@ -0,0 +1,390 @@ +// File for testing: manwhitU.laz + +unit MannWhitUUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionslIB, Globals, DataProcs; + +type + + { TMannWhitUFrm } + + TMannWhitUFrm = class(TForm) + Bevel2: TBevel; + Bevel3: TBevel; + GrpIn: TBitBtn; + GrpOut: TBitBtn; + DepIn: TBitBtn; + DepOut: TBitBtn; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + GrpEdit: TEdit; + DepEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure DepInClick(Sender: TObject); + procedure DepOutClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure GrpInClick(Sender: TObject); + procedure GrpOutClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + MannWhitUFrm: TMannWhitUFrm; + +implementation + +uses + Math; + +{ TMannWhitUFrm } + +procedure TMannWhitUFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + GrpEdit.Text := ''; + DepEdit.Text := ''; + VarList.Items.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TMannWhitUFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := (Label3.Width + GrpIn.Width + 2 * VarList.BorderSpacing.Left + Bevel3.Width div 2) * 2; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TMannWhitUFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TMannWhitUFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TMannWhitUFrm.ComputeBtnClick(Sender: TObject); +var + i, j, ind_var, dep_var, min_grp, max_grp, group, total_n : integer; + NoTies, NoTieGroups, n1, n2, nogroups, largestn : integer; + NoSelected : integer; + ColNoSelected : IntDyneVec; + group_count : IntdyneVec; + Ranks, X : DblDyneMat; + RankSums : DblDyneVec; + TieSum, score, t, SumT, Avg, z, prob, U, U2, SD, Temp : double; + cellstring, outline : string; + lReport: TStrings; + +begin + total_n := 0; + NoTieGroups := 0; + NoSelected := 2; + SumT := 0.0; + + // Check for data + if (NoVariables < 1) then + begin + MessageDlg('You must have grid data!', mtError, [mbOK], 0); + exit; + end; + + // allocate space + SetLength(ColNoSelected,NoVariables); + + // Get column numbers of the independent and dependent variables + ind_var := 0; + dep_var := 0; + for i := 1 to NoVariables do + begin + cellstring := GrpEdit.Text; + if (cellstring = OS3MainFrm.DataGrid.Cells[i,0]) then ind_var := i; + cellstring := DepEdit.Text; + if (cellstring = OS3MainFrm.DataGrid.Cells[i,0]) then dep_var := i; + end; + ColNoSelected[0] := ind_var; + ColNoSelected[1] := dep_var; + if ind_var = 0 then + begin + MessageDlg('No group variable.', mtError, [mbOK], 0); + exit; + end; + if dep_var = 0 then + begin + MessageDlg('No dependent variable.', mtError, [mbOk], 0); + exit; + end; + + //get minimum and maximum group codes + min_grp := 10000; + max_grp := -10000; + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ind_var,i]))); + if (group < min_grp) then min_grp := group; + if (group > max_grp) then max_grp := group; + total_n := total_n + 1; + end; + nogroups := max_grp - min_grp + 1; + + // Initialize arrays + SetLength(RankSums,nogroups); + SetLength(Ranks,NoCases,2); + SetLength(X,NoCases,2); + SetLength(group_count,nogroups); + for i := 0 to nogroups-1 do + begin + group_count[i] := 0; + RankSums[i] := 0.0; + end; + + // Setup for printer output + lReport := TStringList.Create; + try + lReport.Add('MANN-WHITNEY U TEST'); + lReport.Add('See pages 116-127 in S. Siegel: Nonparametric Statistics for the Behavioral Sciences'); + lReport.Add(''); + + // Get data + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + score := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[dep_var,i])); + group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ind_var,i]))); + group := group - min_grp + 1; + if (group > 2) then + begin + MessageDlg('Group codes must be 1 and 2!', mtError, [mbOk], 0); + exit; + end; + group_count[group-1] := group_count[group-1] + 1; + X[i-1,0] := score; + X[i-1,1] := group; + end; + + //Sort all scores in ascending order + for i := 1 to total_n - 1 do + begin + for j := i + 1 to total_n do + begin + if (X[i-1,0] > X[j-1,0]) then + begin + Temp := X[i-1,0]; + X[i-1,0] := X[j-1,0]; + X[j-1,0] := Temp; + Temp := X[i-1,1]; + X[i-1,1] := X[j-1,1]; + X[j-1,1] := Temp; + end; + end; + end; + + // Store ranks + for i := 1 to total_n do + begin + Ranks[i-1,0] := i; + Ranks[i-1,1] := X[i-1,1]; + end; + + //Check for ties in ranks - replace with average rank and calculate + //T for each tie and sum of the T's + i := 1; + while i < total_n do + begin + j := i + 1; + TieSum := 0; + NoTies := 0; + while (j < total_n) do + begin + if (X[j-1,0] > X[i-1,0]) then + break; + if (X[j-1,0] = X[i-1,0]) then // match + begin + TieSum := TieSum + round(Ranks[j-1,0]); + NoTies := NoTies + 1; + end; + j := j + 1; + end; + + if (NoTies > 0) then //At least one tie found + begin + TieSum := TieSum + Ranks[i-1,0]; + NoTies := NoTies + 1; + Avg := TieSum / NoTies; + for j := i to i + NoTies - 1 do Ranks[j-1,0] := Avg; + t := Power(NoTies,3) - NoTies; + SumT := SumT + t; + NoTieGroups := NoTieGroups + 1; + i := i + (NoTies - 1); + end; + i := i + 1; + end; // next i + + // Calculate sum of ranks in each group + for i := 1 to total_n do + begin + group := round(Ranks[i-1,1]); + RankSums[group-1] := RankSums[group-1] + Ranks[i-1,0]; + end; + + //Calculate U for larger and smaller groups + n1 := group_count[0]; + n2 := group_count[1]; + if (n1 > n2) then + U := n1 * n2 + n1 * (n1 + 1) / 2.0 - RankSums[0] + else + U := n1 * n2 + n2 * (n2 + 1) / 2.0 - RankSums[1]; + U2 := n1 * n2 - U; + SD := n1 * n2 * (n1 + n2 + 1) / 12.0; + SD := sqrt(SD); + if (U2 > U) then + z := (U2 - n1 * n2 / 2) / SD + else + z := (U - n1 * n2 / 2) / SD; + prob := 1.0 - probz(z); + + //Report results + lReport.Add(' Score Rank Group'); + lReport.Add(''); + for i := 1 to total_n do + lReport.Add('%10.2f %10.2f %10.0f', [X[i-1,0], Ranks[i-1,0], Ranks[i-1,1]]); + lReport.Add(''); + lReport.Add('Sum of Ranks in each Group'); + lReport.Add('Group Sum No. in Group'); + for i := 1 to nogroups do + lReport.Add('%3d %10.2f %5d', [i+min_grp-1, RankSums[i-1], group_count[i-1]]); + lReport.Add(''); + lReport.Add('No. of tied rank groups: %10d', [NoTieGroups]); + if (n1 > n2) then + largestn := n1 + else + largestn := n2; + if (largestn < 20) then + outline := format('Statistic U: %26.4f',[U]) + else + begin + if (U > U2) then + outline := format('Statistic U: %26.4f',[U]) + else + outline := format('Statistic U: %26.4f',[U2]); + end; + lReport.Add(outline); + lReport.Add('z Statistic (corrected for ties): %8.4f', [z]); + lReport.Add(' Probability > z: %8.4f', [prob]); + if (n2 < 20) then + begin + lReport.Add('z test is approximate. Use tables of exact probabilities in Siegel.'); + lReport.Add('(Table J or K, pages 271-277)'); + end; + DisplayReport(lReport); + + finally + lReport.Free; + group_count := nil; + X := nil; + Ranks := nil; + RankSums := nil; + ColNoSelected := nil; + end; +end; + +procedure TMannWhitUFrm.DepInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (DepEdit.Text = '') then + begin + DepEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TMannWhitUFrm.DepOutClick(Sender: TObject); +begin + if DepEdit.Text <> '' then + begin + VarList.Items.Add(DepEdit.Text); + DepEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TMannWhitUFrm.GrpInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (GrpEdit.Text = '') then + begin + GrpEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TMannWhitUFrm.GrpOutClick(Sender: TObject); +begin + if GrpEdit.Text <> '' then + begin + VarList.Items.Add(GrpEdit.Text); + GrpEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TMannWhitUFrm.UpdateBtnStates; +begin + GrpIn.Enabled := (VarList.ItemIndex > -1) and (GrpEdit.Text = ''); + DepIn.Enabled := (VarList.ItemIndex > -1) and (DepEdit.Text = ''); + GrpOut.Enabled := GrpEdit.Text <> ''; + DepOut.Enabled := DepEdit.Text <> ''; +end; + +procedure TMannWhitUFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I mannwhituunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/riditunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/riditunit.lfm new file mode 100644 index 000000000..aa6b99a19 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/riditunit.lfm @@ -0,0 +1,475 @@ +object RIDITFrm: TRIDITFrm + Left = 520 + Height = 369 + Top = 238 + Width = 665 + AutoSize = True + Caption = 'Relative to an Identified Distribution Analysis' + ClientHeight = 369 + ClientWidth = 665 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label5: TLabel + AnchorSideLeft.Control = BonChk + AnchorSideTop.Control = AlphaEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = AlphaEdit + Left = 412 + Height = 15 + Top = 291 + Width = 187 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = '2-tailed Alpha for significance' + ParentColor = False + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = RefGrp + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 400 + Height = 156 + Top = 8 + Width = 257 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 136 + ClientWidth = 253 + TabOrder = 1 + object ObsChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 211 + Caption = 'Show Observed Frequencies' + TabOrder = 0 + end + object ExpChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 211 + Caption = 'Show Expected Frequencies' + TabOrder = 1 + end + object PropChk: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 211 + Caption = 'Show Row and Column Proportions' + TabOrder = 2 + end + object ChiChk: TCheckBox + Left = 12 + Height = 19 + Top = 69 + Width = 211 + Caption = 'Show Cell Chi-Square Values' + TabOrder = 3 + end + object YatesChk: TCheckBox + Left = 12 + Height = 19 + Top = 90 + Width = 211 + Caption = 'Use Yate''s Correction for a 2x2 Table' + TabOrder = 4 + end + object DetailsChk: TCheckBox + Left = 12 + Height = 19 + Top = 111 + Width = 211 + Caption = 'Show Computational Details' + TabOrder = 5 + end + end + object RefGrp: TRadioGroup + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 400 + Height = 72 + Top = 180 + Width = 257 + Anchors = [akTop, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + Caption = 'Reference Variable' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 253 + Items.Strings = ( + 'Let each variable be a reference variable' + 'Use only the reference variable selected' + ) + OnClick = RefGrpClick + TabOrder = 2 + end + object BonChk: TCheckBox + AnchorSideLeft.Control = RefGrp + AnchorSideTop.Control = RefGrp + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 412 + Height = 19 + Top = 260 + Width = 167 + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Use Bonferroni for contrasts' + TabOrder = 3 + end + object AlphaEdit: TEdit + AnchorSideTop.Control = BonChk + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 607 + Height = 23 + Top = 287 + Width = 50 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + TabOrder = 4 + Text = 'AlphaEdit' + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 364 + Height = 25 + Top = 336 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 6 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 430 + Height = 25 + Top = 336 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 7 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 592 + Height = 25 + Top = 336 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 8 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 504 + Height = 25 + Top = 336 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 9 + end + object HelpBtn: TButton + Tag = 143 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 301 + Height = 25 + Top = 336 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 5 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 320 + Width = 665 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = RefGrp + AnchorSideBottom.Control = Bevel1 + Left = 0 + Height = 312 + Top = 0 + Width = 400 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ClientHeight = 312 + ClientWidth = 400 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 8 + Height = 15 + Top = 8 + Width = 46 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = RowEdit + AnchorSideBottom.Control = RowEdit + Left = 222 + Height = 15 + Top = 33 + Width = 103 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Row Labels Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = ColList + AnchorSideTop.Control = ColIn + Left = 222 + Height = 15 + Top = 117 + Width = 92 + Caption = 'Column Variables' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = RefEdit + AnchorSideBottom.Control = RefEdit + Left = 222 + Height = 15 + Top = 272 + Width = 96 + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 2 + Caption = 'Reference Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = RowIn + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 287 + Top = 25 + Width = 170 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object RowIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 186 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = RowInClick + Spacing = 0 + TabOrder = 1 + end + object RowOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = RowIn + AnchorSideTop.Side = asrBottom + Left = 186 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = RowOutClick + Spacing = 0 + TabOrder = 2 + end + object ColIn: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = RowOut + AnchorSideTop.Side = asrBottom + Left = 186 + Height = 28 + Top = 117 + Width = 28 + BorderSpacing.Top = 32 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = ColInClick + Spacing = 0 + TabOrder = 4 + end + object ColOut: TBitBtn + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ColIn + AnchorSideTop.Side = asrBottom + Left = 186 + Height = 28 + Top = 147 + Width = 28 + BorderSpacing.Top = 2 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = ColOutClick + Spacing = 0 + TabOrder = 5 + end + object RowEdit: TEdit + AnchorSideLeft.Control = RowIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = RowOut + AnchorSideBottom.Side = asrBottom + Left = 222 + Height = 23 + Top = 50 + Width = 178 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 3 + Text = 'RowEdit' + end + object ColList: TListBox + AnchorSideLeft.Control = ColOut + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Label4 + Left = 222 + Height = 130 + Top = 134 + Width = 170 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnClick = ColListClick + TabOrder = 6 + end + object RefEdit: TEdit + AnchorSideLeft.Control = ColOut + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 222 + Height = 23 + Top = 289 + Width = 170 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + TabOrder = 7 + Text = 'RefEdit' + end + object Bevel2: TBevel + Left = 386 + Height = 20 + Top = 288 + Width = 14 + Shape = bsSpacer + end + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/riditunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/riditunit.pas new file mode 100644 index 000000000..1f6c97566 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/riditunit.pas @@ -0,0 +1,733 @@ +unit RIDITUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, FunctionsLib, OutputUnit, MatrixLib, ContextHelpUnit; + +type + + { TRIDITFrm } + + TRIDITFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + BonChk: TCheckBox; + AlphaEdit: TEdit; + HelpBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ReturnBtn: TButton; + ComputeBtn: TButton; + Label5: TLabel; + ObsChk: TCheckBox; + ExpChk: TCheckBox; + PropChk: TCheckBox; + ChiChk: TCheckBox; + RefGrp: TRadioGroup; + YatesChk: TCheckBox; + DetailsChk: TCheckBox; + ColList: TListBox; + GroupBox1: TGroupBox; + RefEdit: TEdit; + Label4: TLabel; + RowEdit: TEdit; + Label2: TLabel; + Label3: TLabel; + RowIn: TBitBtn; + RowOut: TBitBtn; + ColIn: TBitBtn; + ColOut: TBitBtn; + Label1: TLabel; + VarList: TListBox; + procedure ColInClick(Sender: TObject); + procedure ColListClick(Sender: TObject); + procedure ColOutClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure RefGrpClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure RowInClick(Sender: TObject); + procedure RowOutClick(Sender: TObject); + procedure Analyze(RefCol : integer; ColNoSelected : IntDyneVec; + RowLabels : StrDyneVec; ColLabels : StrDyneVec; + NoToAnalyze : integer; Freq : IntDyneMat; + Props : DblDyneMat; NoRows : integer); + + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + RIDITFrm: TRIDITFrm; + +implementation + +uses + Math; + +{ TRIDITFrm } + +procedure TRIDITFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + ColList.Clear; + RowEdit.Text := ''; + RefEdit.Text := ''; + AlphaEdit.Text := '0.05'; + BonChk.Checked := true; + RowIn.Enabled := true; + RowOut.Enabled := false; + ColIn.Enabled := true; + ColOut.Enabled := false; + Label4.Visible := false; + RefEdit.Visible := false; + RefGrp.ItemIndex := 1; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TRIDITFrm.RowInClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + RowEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + RowIn.Enabled := false; + RowOut.Enabled := true; +end; + +procedure TRIDITFrm.RowOutClick(Sender: TObject); +begin + VarList.Items.Add(RowEdit.Text); + RowEdit.Text := ''; + RowIn.Enabled := true; + RowOut.Enabled := false; +end; + +procedure TRIDITFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TRIDITFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TRIDITFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TRIDITFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TRIDITFrm.RefGrpClick(Sender: TObject); +begin + if (RefGrp.ItemIndex = 0) then // do all variables as reference variable + begin + Label4.Visible := false; + RefEdit.Visible := false; + end + else + begin + Label4.Visible := true; + RefEdit.Visible := true; + end; +end; + +procedure TRIDITFrm.ColInClick(Sender: TObject); +VAR index, i : integer; +begin + index := VarList.Items.Count; + i := 0; + while (i < index) do + begin + if (VarList.Selected[i]) then + begin + ColList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + ColOut.Enabled := true; +end; + +procedure TRIDITFrm.ColListClick(Sender: TObject); +VAR index : integer; +begin + index := ColList.ItemIndex; + + RefEdit.Text := ColList.Items.Strings[index]; + +end; + +procedure TRIDITFrm.ColOutClick(Sender: TObject); +VAR index : integer; +begin + index := ColList.ItemIndex; + if (index < 0) then + begin + ColOut.Enabled := false; + exit; + end; + VarList.Items.Add(ColList.Items.Strings[index]); + ColList.Items.Delete(index); +end; + +procedure TRIDITFrm.ComputeBtnClick(Sender: TObject); +VAR + AllRefs : boolean; + i, j, RowNo, RefColNo, NoToAnalyze : integer; + Row, Col, Ncases, Nrows, Ncols, df : integer; + RowLabels, ColLabels : StrDyneVec; + ColNoSelected : IntDyneVec; + cellstring : string; + outline : string; + Freq : IntDyneMat; + Prop, Expected, CellChi : DblDyneMat; + ChiSquare, ProbChi : double; + yates : boolean; + Adjchisqr, Adjprobchi: double; + liklihood, probliklihood, phi : double; + pearsonr, VarX, VarY, SumX, SumY, MantelHaenszel, MHProb, CoefCont : double; + CramerV : double; +begin + AllRefs := true; + if (RefGrp.ItemIndex = 1) then AllRefs := false; + SetLength(ColNoSelected,NoVariables+1); + yates := false; + RowNo := 0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if (cellstring = RowEdit.Text) then RowNo := i; + end; +{ + results := VarTypeChk(RowNo,2); + if (result = 1) + begin + delete[] ColNoSelected; + return; + end; +} + Nrows := NoCases; + Ncols := ColList.Items.Count; + SetLength(RowLabels,Nrows+1); + SetLength(ColLabels,Ncols+1); + + if (RowNo = 0) then + begin + ShowMessage('ERROR! A variable for the row labels was not entered.'); + ColNoSelected := nil; + exit; + end; + ColNoSelected[0] := RowNo; + + // Get Column labels + for i := 0 to Ncols - 1 do + begin + ColLabels[i] := ColList.Items.Strings[i]; + for j := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[j,0]; + if (cellstring = ColLabels[i]) then + begin + ColNoSelected[i+1] := j; + { result := VarTypeChk(j,1); + if (result = 1) + begin + delete[] ColLabels; + delete[] RowLabels; + delete[] ColNoSelected; + return; + end; } + end; + end; + end; + + // Get row labels + for i := 1 to NoCases do + begin + RowLabels[i-1] := OS3MainFrm.DataGrid.Cells[RowNo,i]; + end; + + // allocate and initialize + SetLength(Freq,Nrows+1,Ncols+1); + SetLength(Prop,Nrows+1,Ncols+1); + SetLength(Expected,Nrows,Ncols); + SetLength(CellChi,Nrows,Ncols); + for i := 1 to Nrows + 1 do + for j := 1 to Ncols + 1 do Freq[i-1,j-1] := 0; + RowLabels[Nrows] := 'Total'; + ColLabels[Ncols] := 'Total'; + + // get cell data + Ncases := 0; + for i := 1 to NoCases do + begin + Row := i; + for j := 1 to Ncols do + begin + Col := ColNoSelected[j]; + Freq[i-1,j-1] := StrToInt(OS3MainFrm.DataGrid.Cells[Col,Row]); +// result := GetValue(Row,Col,intvalue,dblvalue,strvalue); +// if (result = 1) Freq[i-1][j-1] := 0; +// else Freq[i-1][j-1] := intvalue; + Ncases := Ncases + Freq[i-1,j-1]; + end; + end; + Freq[Nrows][Ncols] := Ncases; + + // Now, calculate expected values + // Get row totals first + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + Freq[i-1,Ncols] := Freq[i-1,Ncols] + Freq[i-1,j-1]; + end; + end; + // Get col totals next + for j := 1 to Ncols do + begin + for i := 1 to Nrows do + begin + Freq[Nrows,j-1] := Freq[Nrows,j-1] + Freq[i-1,j-1]; + end; + end; + + // Then get expected values and cell chi-squares + ChiSquare := 0.0; + Adjchisqr := 0.0; + if ((YatesChk.Checked) and (Nrows = 2) and (Ncols = 2)) then yates := true; + if ((Nrows > 1) and (Ncols > 1)) then + begin + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + Expected[i-1,j-1] := Freq[Nrows,j-1] * Freq[i-1,Ncols] / Ncases; + if (Expected[i-1,j-1] > 0.0) then + CellChi[i-1,j-1] := sqr(Freq[i-1,j-1] - Expected[i-1,j-1]) + / Expected[i-1,j-1] + else + begin + ShowMessage('ERROR! Zero expected value found.'); + CellChi[i-1,j-1] := 0.0; + end; + ChiSquare := ChiSquare + CellChi[i-1,j-1]; + end; + end; + df := (Nrows - 1) * (Ncols - 1); + if (yates = true) then // 2 x 2 corrected chi-square + begin + Adjchisqr := abs((Freq[0,0] * Freq[1,1]) - (Freq[0,1] * Freq[1,0])); + Adjchisqr := sqr(Adjchisqr - Ncases / 2.0) * Ncases; // numerator + Adjchisqr := Adjchisqr / (Freq[0,2] * Freq[1,2] * Freq[2,0] * Freq[2,1]); + Adjprobchi := 1.0 - chisquaredprob(Adjchisqr,df); + end; + end; + if (Nrows = 1) then // equal probability + begin + for j := 0 to Ncols - 1 do + begin + Expected[0,j] := Ncases / Ncols; + if (Expected[0][j] > 0) then + CellChi[0,j] := sqr(Freq[0,j] - Expected[0,j]) / Expected[0,j]; + ChiSquare := ChiSquare + CellChi[0,j]; + end; + df := Ncols - 1; + end; + + if (Ncols = 1) then // equal probability + begin + for i := 0 to Nrows - 1 do + begin + Expected[i,0] := Ncases / Nrows; + if (Expected[i,0] > 0) then + CellChi[i,0] := sqr(Freq[i,0] - Expected[i,0]) / Expected[i,0]; + ChiSquare := ChiSquare + CellChi[i,0]; + end; + df := Nrows - 1; + end; + + ProbChi := 1.0 - chisquaredprob(ChiSquare,df); // prob. larger chi + + //Print results to output form + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Chi-square Analysis Results'); + outline := format('No. of Cases = %d',[Ncases]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + // print tables requested by use + if (ObsChk.Checked) then + begin + IntArrayPrint(Freq, Nrows+1, Ncols+1,'Frequencies', + RowLabels, ColLabels,'OBSERVED FREQUENCIES'); + end; + + if (ExpChk.Checked) then + begin + outline := 'EXPECTED FREQUENCIES'; + MAT_PRINT(Expected, Nrows, Ncols, outline, RowLabels, ColLabels, + NoCases); + end; + + if (PropChk.Checked) then outline := 'ROW PROPORTIONS'; + for i := 1 to Nrows + 1 do + begin + for j := 1 to Ncols do + begin + if (Freq[i-1,Ncols] > 0.0) then + Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[i-1,Ncols] + else Prop[i-1,j-1] := 0.0; + end; + if (Freq[i-1,Ncols] > 0.0) then Prop[i-1,Ncols] := 1.0 + else Prop[i-1,Ncols] := 0.0; + end; + if (PropChk.Checked) then + MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, + NoCases); + if (PropChk.Checked) then outline := 'COLUMN PROPORTIONS'; + for j := 1 to Ncols + 1 do + begin + for i := 1 to Nrows do + begin + if (Freq[Nrows,j-1] > 0.0) then + Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[Nrows,j-1] + else Prop[i-1,j-1] := 0.0; + end; + if (Freq[Nrows,j-1] > 0.0) then Prop[Nrows,j-1] := 1.0 + else Prop[Nrows,j-1] := 0.0; + end; + if (PropChk.Checked) then + MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, + NoCases); + + if (ChiChk.Checked) then + begin + outline := 'CHI-SQUARED VALUE FOR CELLS'; + MAT_PRINT(CellChi, Nrows, Ncols, outline, RowLabels, ColLabels, + NoCases); + end; + + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Chi-square = %8.3f with D.F. = %d. Prob. > value = %8.3f', + [ChiSquare,df,ProbChi]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + if (yates = true) then + begin + outline := format('Chi-square using Yates correction = %8.3f and Prob > value = %8.3f', + [Adjchisqr,Adjprobchi]); + OutPutFrm.RichEdit.Lines.Add(outline); + end; + + liklihood := 0.0; + for i := 0 to Nrows - 1 do + for j := 0 to Ncols - 1 do + if (Freq[i,j] > 0.0) then + liklihood := liklihood + Freq[i,j] * (ln(Expected[i,j] / Freq[i,j])); + liklihood := -2.0 * liklihood; + probliklihood := 1.0 - chisquaredprob(liklihood,df); + outline := format('Liklihood Ratio = %8.3f with prob. > value = %6.4f', + [liklihood,probliklihood]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + if ((Nrows > 1) and (Ncols > 1)) then + begin + phi := sqrt(ChiSquare / Ncases); + outline := format('phi correlation = %6.4f',[phi]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + pearsonr := 0.0; + SumX := 0.0; + SumY := 0.0; + VarX := 0.0; + VarY := 0.0; + for i := 0 to Nrows - 1 do SumX := SumX + ( (i+1) * Freq[i,Ncols] ); + for j := 0 to Ncols - 1 do SumY := SumY + ( (j+1) * Freq[Nrows,j] ); + for i := 0 to Nrows - 1 do VarX := VarX + ( ((i+1)*(i+1)) * Freq[i,Ncols] ); + for j := 0 to Ncols - 1 do VarY := VarY + ( ((j+1)*(j+1)) * Freq[Nrows,j] ); + VarX := VarX - ((SumX * SumX) / Ncases); + VarY := VarY - ((SumY * SumY) / Ncases); + for i := 0 to Nrows - 1 do + for j := 0 to Ncols - 1 do + pearsonr := pearsonr + ((i+1)*(j+1) * Freq[i,j]); + pearsonr := pearsonr - (SumX * SumY / Ncases); + pearsonr := pearsonr / sqrt(VarX * VarY); + outline := format('Pearson Correlation r = %6.4f',[pearsonr]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + MantelHaenszel := (Ncases-1) * (pearsonr * pearsonr); + MHprob := 1.0 - chisquaredprob(MantelHaenszel,1); + outline := format('Mantel-Haenszel Test of Linear Association = %8.3f with probability > value = %6.4f', + [MantelHaenszel, MHprob]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + CoefCont := sqrt(ChiSquare / (ChiSquare + Ncases)); + outline := format('The coefficient of contingency = %8.3f',[CoefCont]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + if (Nrows < Ncols) then CramerV := sqrt(ChiSquare / (Ncases * ((Nrows-1)))) + else CramerV := sqrt(ChiSquare / (Ncases * ((Ncols-1)))); + outline := format('Cramers V = %8.3f',[CramerV]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal(); + OutputFrm.RichEdit.Clear(); + + // Now do RIDIT analysis + NoToAnalyze := ColList.Items.Count; + + if (AllRefs) then // do an analysis for each variable as a reference variable + begin + NoToAnalyze := ColList.Items.Count; + for i := 0 to NoToAnalyze - 1 do + begin + RefColNo := ColNoSelected[i+1] - 2; + Analyze(RefColNo, ColNoSelected, RowLabels,ColLabels, + NoToAnalyze,Freq,Prop, Nrows); + end; + end + else // only one selected reference variable + begin + NoToAnalyze := ColList.Items.Count; + // get column of reference variable + for i := 1 to NoVariables do + begin + if (RefEdit.Text = OS3MainFrm.DataGrid.Cells[i,0]) then RefColNo := i; + + end; + for j := 0 to NoToAnalyze - 1 do + begin + if (ColNoSelected[j+1] = RefColNo) then RefColNo := j; + end; + Analyze(RefColNo, ColNoSelected, RowLabels,ColLabels, + NoToAnalyze,Freq, Prop, Nrows); + end; + + ColLabels := nil; + RowLabels := nil; + CellChi := nil; + Expected := nil; + Prop := nil; + Freq := nil; + ColNoSelected := nil; +end; + +procedure TRIDITFrm.Analyze(RefCol : integer; ColNoSelected : IntDyneVec; + RowLabels : StrDyneVec; ColLabels : StrDyneVec; + NoToAnalyze : integer; Freq : IntDyneMat; + Props : DblDyneMat; NoRows : integer); +VAR + probdists : DblDyneMat; + refprob : DblDyneMat; + sizes : DblDyneVec; + meanridits : DblDyneVec; + Cratios : DblDyneVec; + OverMeanRidit : double; + chisquare : double; + probchi : double; + alpha : double; + StdErr : DblDyneVec; + Bonferroni : double; + i, j : integer; + outline : string; + outstring : string; + details : boolean; + term1,term2,term3,term4 : double; + +begin + details := false; + SetLength(probdists,NoRows,NoToAnalyze); + SetLength(refprob,NoRows,4); + SetLength(sizes,NoToAnalyze); + SetLength(meanridits,NoToAnalyze); + SetLength(Cratios,NoToAnalyze); + SetLength(StdErr,NoToAnalyze); + + alpha := StrToFloat(AlphaEdit.Text); + if (DetailsChk.Checked) then details := true; + + outline := format('ANALYSIS FOR STANDARD %s',[ColLabels[RefCol]]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + // print frequencies + outline := 'Frequencies Observed'; + IntArrayPrint(Freq, NoRows, NoToAnalyze, 'Frequencies', RowLabels, ColLabels, + outline); + + // print column proportions + outline := 'Column Proportions Observed'; + MAT_PRINT(Props, NoRows, NoToAnalyze, outline, RowLabels, ColLabels, + NoCases); + + // Get sizes in each column + for i := 0 to NoToAnalyze - 1 do + begin + sizes[i] := Freq[NoRows,i]; + end; + // Get the reference variable probabilities for all variables + for j := 0 to NoToAnalyze - 1 do + begin + for i := 0 to NoRows - 1 do + begin + refprob[i,0] := Props[i,j]; + refprob[i,1] := Props[i,j] / 2.0; + end; + refprob[0,2] := 0.0; + for i := 1 to NoRows - 1 do refprob[i,2] := refprob[i-1,2] + refprob[i-1,0]; + for i := 0 to NoRows - 1 do refprob[i,3] := refprob[i,1] + refprob[i,2]; + if (details) then // print calculations table + begin + outstring := 'Ridit calculations for ' + ColLabels[j]; + outline := outstring; + MAT_PRINT(refprob, NoRows, 4, outline, RowLabels, ColLabels, + NoCases); + end; + // store results in probdists + for i := 0 to NoRows - 1 do probdists[i,j] := refprob[i,3]; + end; + outstring := 'Ridits for all variables'; + outline := outstring; + MAT_PRINT(probdists, NoRows, NoToAnalyze, outline, RowLabels, ColLabels, + NoCases); + + // obtain mean ridits for the all variables using the reference variable + for i := 0 to NoToAnalyze - 1 do + begin + meanridits[i] := 0.0; + for j := 0 to NoRows - 1 do + begin + meanridits[i] := meanridits[i] + (probdists[j,RefCol] * Freq[j,i]); + end; + meanridits[i] := meanridits[i] / sizes[i]; + end; + // print the means using the reference variable + outline := 'Mean RIDITS Using the Reference Values'; + DynVectorPrint(meanridits,NoToAnalyze,outline,ColLabels,NoCases); + // obtain the weighted grand mean ridit + OverMeanRidit := 0.0; + for i := 0 to NoToAnalyze - 1 do + begin + if (i <> RefCol) then OverMeanRidit := OverMeanRidit + sizes[i] * meanridits[i]; + end; + OverMeanRidit := OverMeanRidit / (Freq[NoRows,NoToAnalyze] - sizes[RefCol]); + outline := format('Overall mean for RIDITS in non-reference groups := %8.4f',[OverMeanRidit]); + OutputFrm.RichEdit.Lines.Add(outline); + // obtain chisquare + chisquare := 0.0; + term4 := (OverMeanRidit - 0.5) * (OverMeanRidit - 0.5); + term3 := 0.0; + for i := 0 to NoToAnalyze - 1 do + begin + if (i <> RefCol) then term3 := term3 + (sizes[i] * sizes[i]); + end; + term3 := 12.0 * term3; + term2 := Freq[NoRows,NoToAnalyze]; + term1 := 0.0; + for i := 0 to NoToAnalyze - 1 do + begin + if (i <> RefCol) then + term1 := term1 + (sizes[i] * ((meanridits[i] - 0.5) * (meanridits[i] - 0.5))); + end; + term1 := term1 * 12.0; + chisquare := term1 - ((term3 / term2) * term4); + probchi := 1.0 - chisquaredprob(chisquare,NoToAnalyze-1); + outline := format('Chisquared := %8.3f with probability < %8.4f',[chisquare,probchi]); + OutputFrm.RichEdit.Lines.Add(outline); + // do pairwise comparisons + Cratios[RefCol] := 0.0; + for i := 0 to NoToAnalyze - 1 do + begin + if (i <> RefCol) then + begin + StdErr[i] := sqrt(sizes[RefCol] + sizes[i]) / + (2.0 * sqrt(3.0 * sizes[RefCol] * sizes[i])); + Cratios[i] := ( meanridits[i] - 0.5) / StdErr[i]; + end; + end; + outline := 'z critical ratios'; + DynVectorPrint(Cratios,NoToAnalyze,outline,ColLabels,NoCases); + alpha := alpha / 2.0; + if (BonChk.Checked) then alpha := alpha / (NoToAnalyze - 1); + Bonferroni := inversez(1.0 - alpha); + outline := format('significance level used for comparisons := %8.3f',[Bonferroni]); + OutputFrm.RichEdit.Lines.Add(outline); + for i := 0 to NoToAnalyze - 1 do + begin + if (i <> RefCol) then + begin + if (abs(Cratios[i]) > Bonferroni) then + begin + outline := format('%s vs %s significant',[ColLabels[i],ColLabels[RefCol]]); + OutputFrm.RichEdit.Lines.Add(outline); + end + else + begin + outline := format('%s vs %s not significant',[ColLabels[i],ColLabels[RefCol]]); + OutPutFrm.RichEdit.Lines.Add(outline); + end; + end; + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + + // cleanup + StdErr := nil; + Cratios := nil; + meanridits := nil; + sizes := nil; + refprob := nil; + probdists := nil; +end; + +initialization + {$I riditunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/runstestunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/runstestunit.lfm new file mode 100644 index 000000000..e951068ef --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/runstestunit.lfm @@ -0,0 +1,451 @@ +object runstestform: Trunstestform + Left = 476 + Height = 438 + Top = 209 + Width = 376 + AutoSize = True + Caption = 'Test for Randomness' + ClientHeight = 438 + ClientWidth = 376 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 54 + Width = 100 + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + Caption = 'Available Variables:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = TestVarEdit + AnchorSideBottom.Control = TestVarEdit + Left = 210 + Height = 15 + Top = 79 + Width = 108 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Test Randomness of:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + AnchorSideBottom.Control = ProbEdit + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 287 + Top = 71 + Width = 158 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 174 + Height = 28 + Top = 71 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = InBtn + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 174 + Height = 28 + Top = 103 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object TestVarEdit: TEdit + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = OutBtn + AnchorSideBottom.Side = asrBottom + Left = 210 + Height = 23 + Top = 96 + Width = 158 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 3 + Text = 'TestVarEdit' + end + object Label3: TLabel + AnchorSideTop.Control = MeanEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = MeanEdit + Left = 244 + Height = 15 + Top = 177 + Width = 33 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Mean:' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = InBtn + AnchorSideTop.Control = StdDevEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = StdDevEdit + Left = 174 + Height = 15 + Top = 204 + Width = 103 + BorderSpacing.Right = 8 + Caption = 'Standard Deviation:' + ParentColor = False + end + object Label5: TLabel + AnchorSideTop.Control = NUpEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NUpEdit + Left = 185 + Height = 15 + Top = 231 + Width = 92 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'N Values > Mean:' + ParentColor = False + end + object Label6: TLabel + AnchorSideTop.Control = NDownEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NDownEdit + Left = 185 + Height = 15 + Top = 258 + Width = 92 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'N Values < Mean:' + ParentColor = False + end + object Label7: TLabel + AnchorSideTop.Control = NRunsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NRunsEdit + Left = 187 + Height = 15 + Top = 285 + Width = 90 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Number of Runs:' + ParentColor = False + end + object Label8: TLabel + AnchorSideTop.Control = StatEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = StatEdit + Left = 210 + Height = 15 + Top = 312 + Width = 67 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Test Statistic:' + ParentColor = False + end + object Label9: TLabel + AnchorSideTop.Control = ProbEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ProbEdit + Left = 217 + Height = 15 + Top = 339 + Width = 60 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Probability:' + ParentColor = False + end + object Label10: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ConclusionEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 370 + Width = 63 + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Conclusion:' + ParentColor = False + end + object MeanEdit: TEdit + AnchorSideLeft.Control = StdDevEdit + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = StdDevEdit + Left = 285 + Height = 23 + Top = 173 + Width = 83 + Alignment = taRightJustify + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 4 + ReadOnly = True + TabOrder = 4 + Text = 'MeanEdit' + end + object StdDevEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = NUpEdit + Left = 285 + Height = 23 + Top = 200 + Width = 83 + Alignment = taRightJustify + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 4 + ReadOnly = True + TabOrder = 5 + Text = 'Edit1' + end + object NUpEdit: TEdit + AnchorSideLeft.Control = StdDevEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = NDownEdit + Left = 285 + Height = 23 + Top = 227 + Width = 83 + Alignment = taRightJustify + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 4 + ReadOnly = True + TabOrder = 6 + Text = 'Edit1' + end + object NDownEdit: TEdit + AnchorSideLeft.Control = StdDevEdit + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = NRunsEdit + Left = 285 + Height = 23 + Top = 254 + Width = 83 + Alignment = taRightJustify + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 4 + ReadOnly = True + TabOrder = 7 + Text = 'Edit1' + end + object NRunsEdit: TEdit + AnchorSideLeft.Control = StdDevEdit + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = StatEdit + Left = 285 + Height = 23 + Top = 281 + Width = 83 + Alignment = taRightJustify + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 4 + ReadOnly = True + TabOrder = 8 + Text = 'Edit1' + end + object StatEdit: TEdit + AnchorSideLeft.Control = StdDevEdit + AnchorSideRight.Control = StdDevEdit + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ProbEdit + Left = 285 + Height = 23 + Top = 308 + Width = 83 + Alignment = taRightJustify + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 4 + ReadOnly = True + TabOrder = 9 + Text = 'Edit1' + end + object ProbEdit: TEdit + AnchorSideLeft.Control = StdDevEdit + AnchorSideRight.Control = StdDevEdit + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ConclusionEdit + Left = 285 + Height = 23 + Top = 335 + Width = 83 + Alignment = taRightJustify + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 8 + ReadOnly = True + TabOrder = 10 + Text = 'Edit1' + end + object ConclusionEdit: TEdit + AnchorSideLeft.Control = Label10 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 79 + Height = 23 + Top = 366 + Width = 289 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 11 + Text = 'Edit1' + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 79 + Height = 25 + Top = 405 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 12 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 145 + Height = 25 + Top = 405 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 13 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 219 + Height = 25 + Top = 405 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 14 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 307 + Height = 25 + Top = 405 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 15 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 389 + Width = 376 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Bevel2: TBevel + Left = 3 + Height = 21 + Top = 414 + Width = 15 + Shape = bsSpacer + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 30 + Top = 8 + Width = 360 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'This is a test for the randomness of a series of values in a variable. Select the variable to analyze and click the Compute button.' + ParentColor = False + WordWrap = True + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/runstestunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/runstestunit.pas new file mode 100644 index 000000000..b67387d0f --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/runstestunit.pas @@ -0,0 +1,277 @@ +unit RunsTestUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, Globals, DataProcs; + +type + + { Trunstestform } + + Trunstestform = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + CancelBtn: TButton; + ComputeBtn: TButton; + MeanEdit: TEdit; + Memo1: TLabel; + ResetBtn: TButton; + ReturnBtn: TButton; + StdDevEdit: TEdit; + NUpEdit: TEdit; + NDownEdit: TEdit; + NRunsEdit: TEdit; + StatEdit: TEdit; + ProbEdit: TEdit; + ConclusionEdit: TEdit; + InBtn: TBitBtn; + OutBtn: TBitBtn; + Label10: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Label7: TLabel; + Label8: TLabel; + Label9: TLabel; + TestVarEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + runstestform: Trunstestform; + +implementation + +uses + Math; + +{ Trunstestform } + +procedure Trunstestform.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + TestVarEdit.Text := ''; + MeanEdit.Text := ''; + StdDevEdit.Text := ''; + NUpEdit.Text := ''; + NDownEdit.Text := ''; + StatEdit.Text := ''; + ProbEdit.Text := ''; + ConclusionEdit.Text := ''; + NRunsEdit.Text := ''; + InBtn.Enabled := true; + OutBtn.Enabled := false; +end; + +procedure Trunstestform.ComputeBtnClick(Sender: TObject); +VAR + a, i, col, N, N1, N2, NLess, Nmore, R : integer; + Mean, ExpMean, SD1, SD2, SD3, SD4, SD, z1, z2, z, t, p1, p : double; + strvalue, outstr, astring : string; + values : DblDyneVec; + +begin + col := 0; + N := 0; + N1 := 0; + N2 := 0; + Nless := 0; + Nmore := 0; + R := 1; + Mean := 0.0; + for i := 1 to NoVariables do + begin + strvalue := Trim(OS3MainFrm.DataGrid.Cells[i,0]); + if TestVarEdit.Text = strvalue then col := i; + end; + if col = 0 then + begin + ShowMessage('No variable was selected. Returning.'); + exit; + end; + SetLength(values,NoCases); + for i := 1 to NoCases do + begin + if not ValidValue(i,col) then continue; + values[i-1] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); + N := N + 1; + end; + if N <= 10 then + begin + ShowMessage('Insufficient data. You must have at least 11 values.'); + values := nil; + exit; + end; + for i := 0 to N-1 do Mean := Mean + values[i]; + Mean := Mean / N; + // run through each value and compare with the mean + for i := 0 to N-1 do + begin // check and discard the ties with the mean + if Mean <> values[i] then + begin // check if it is greater than the mean + if values[i] > mean then + begin + N1 := N1 + 1; + a := i; + while a > 0 do + begin + a := a - 1; + if values[a] <> Mean then break; + end; + if values[a] < Mean then + begin + R := R + 1; + NLess := NLess + 1; + end; + end + // check to see if it is less than the mean + else if values[i] < Mean then + begin + N2 := N2 + 1; + a := i; + while a > 0 do + begin + a := a - 1; + if values[a] <> Mean then break; + end; + if values[a] > Mean then + begin + R := R + 1; + Nmore := Nmore + 1; + end; + end; // close of else i + end; // end of if values[i] not equal to the mean + end; // end of i loop + // compute the expected mean and variance of R + ExpMean := 1.0 + ((2 * N1 * N2) / (N1 + N2)); // mean mu + SD1 := 2 * N1 * N2 * (2 * N1 * N2 - N1 - N2); + SD2 := power((N1 + N2),2); + SD3 := N1 + N2 - 1; + SD4 := SD1 / (SD2 * SD3); // standard deviation "sigma" + SD := sqrt(SD4); + // calculating P Value + z1 := (R - ExpMean) / SD; + z2 := abs(z1); + z := z2; + if z > 0 then t := z else t := -z; + p1 := power((1 + t * (0.049867347 + t * (0.0211410061 + t * (0.0032776283 + + t * (0.0000380036 + t * (0.0000488906 + t * (0.000005383))))))), -16); + p := 1.0 - p1 / 2.0; + if z > 0.0 then t := 1.0 - p + else t := 1.0 - (1.0 - p); // this is P value + // show results + outstr := format('%8.3f',[Mean]); + MeanEdit.Text := outstr; + outstr := format('%8.3f',[SD]); + StdDevEdit.Text := outstr; + NUpEdit.Text := IntToStr(N1); + NDownEdit.Text := IntToStr(N2); + NRunsEdit.Text := IntToStr(R); + outstr := format('%8.3f',[z]); + StatEdit.Text := outstr; +// if t < 0.0001 then astring := 'Almost Zero' +// else +// begin + outstr := format('%6.4f',[t]); + ProbEdit.Text := outstr; +// end; + // determine the conclusion + if t < 0.01 then + begin + astring := 'Very strong evidence against randomness (trend or seasonality'; + ConclusionEdit.Text := astring; + end + else if (t < 0.05) and (t >= 0.01) then + begin + astring := 'Moderate evidence against randomness'; + ConclusionEdit.Text := astring; + end + else if (t < 0.10) and (t >= 0.05) then + begin + astring := 'Suggestive evidence against normality'; + ConclusionEdit.Text := astring; + end + else if t >= 0.10 then + begin + astring := 'Little or no real evidence against randomness'; + ConclusionEdit.Text := astring; + end + else + begin + astring := 'Strong evidence against randomness (trend or seasonality exists)'; + ConclusionEdit.Text := astring; + end; + values := nil; +end; + +procedure Trunstestform.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure Trunstestform.FormCreate(Sender: TObject); +begin + Assert(OS3Mainfrm <> nil); +end; + +procedure Trunstestform.InBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + if index < 0 then exit; + TestVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + InBtn.Enabled := false; + OutBtn.Enabled := true; +end; + +procedure Trunstestform.OutBtnClick(Sender: TObject); +begin + if TestVarEdit.Text = '' then exit; + VarList.Items.Add(TestVarEdit.Text); + TestVarEdit.Text := ''; + InBtn.Enabled := true; + OutBtn.Enabled := false; +end; + +initialization + {$I runstestunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/sensunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/sensunit.lfm new file mode 100644 index 000000000..5328e0682 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/sensunit.lfm @@ -0,0 +1,365 @@ +object SensForm: TSensForm + Left = 288 + Height = 579 + Top = 161 + Width = 478 + AutoSize = True + Caption = 'Sens Trend Analysis' + ClientHeight = 579 + ClientWidth = 478 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + Left = 43 + Height = 72 + Top = 129 + Width = 182 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 16 + Caption = 'If more than one variable:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 52 + ClientWidth = 178 + TabOrder = 0 + object StandardizeChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 154 + Caption = 'Standardize the measures' + TabOrder = 0 + end + object AvgSlopeChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 154 + Caption = 'Calculate Average Slope' + TabOrder = 1 + end + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox1 + Left = 253 + Height = 72 + Top = 129 + Width = 124 + AutoSize = True + Caption = 'Plot' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 52 + ClientWidth = 120 + TabOrder = 1 + object PlotChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 96 + Caption = 'Each Variable' + TabOrder = 0 + end + object SlopesChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 96 + Caption = 'Ranked Slopes' + TabOrder = 1 + end + end + object GroupBox3: TGroupBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + Left = 43 + Height = 93 + Top = 217 + Width = 182 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 16 + Caption = 'Print' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 73 + ClientWidth = 178 + TabOrder = 2 + object PrtDataChk: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 96 + Caption = 'Data' + TabOrder = 0 + end + object PrtSlopesChk: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 96 + Caption = 'Slopes Matrix' + TabOrder = 1 + end + object PrtRanksChk: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 96 + Caption = 'Ranked Slopes' + TabOrder = 2 + end + end + object Label1: TLabel + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = AlphaEdit + AnchorSideTop.Side = asrCenter + Left = 253 + Height = 15 + Top = 221 + Width = 64 + Caption = 'Alpha Level:' + ParentColor = False + end + object AlphaEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox3 + Left = 325 + Height = 23 + Top = 217 + Width = 47 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 3 + Text = '0.05' + end + object Label2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = GroupBox3 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 318 + Width = 100 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Available Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AllBtn + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 200 + Top = 335 + Width = 200 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + MultiSelect = True + TabOrder = 4 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 225 + Height = 28 + Top = 335 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 5 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 225 + Height = 28 + Top = 367 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 6 + end + object AllBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = OutBtn + AnchorSideTop.Side = asrBottom + Left = 216 + Height = 25 + Top = 411 + Width = 46 + AutoSize = True + BorderSpacing.Top = 16 + Caption = 'ALL' + OnClick = AllBtnClick + Spacing = 0 + TabOrder = 7 + end + object Label3: TLabel + AnchorSideLeft.Control = SelectedList + AnchorSideTop.Control = Label2 + Left = 270 + Height = 15 + Top = 318 + Width = 107 + Caption = 'Variables to Analyze:' + ParentColor = False + end + object SelectedList: TListBox + AnchorSideLeft.Control = AllBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 270 + Height = 195 + Top = 335 + Width = 200 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 8 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 243 + Height = 25 + Top = 546 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 10 + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 177 + Height = 25 + Top = 546 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 9 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 317 + Height = 25 + Top = 546 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 11 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 405 + Height = 25 + Top = 546 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 12 + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 105 + Top = 8 + Width = 462 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Sens method for the detection and estimation of trents is used to analyze one or more variable observations collected at equally spaced intervals of time. First, select one or more series variables to analyze. Next, if you have entered more than one variable, indicate how the measures are to be combined (mean or median) and if the values are to be standardized '#13#10'(z scores with mean of 0 and standard deviation of 1.) Finally, select the options desired and click the compute button to complete the analysis.' + ParentColor = False + WordWrap = True + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 530 + Width = 478 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/sensunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/sensunit.pas new file mode 100644 index 000000000..6b842404c --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/sensunit.pas @@ -0,0 +1,614 @@ +unit SensUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, FunctionsLib, OutputUnit, + ContextHelpUnit, MatrixLib, GraphLib; + +type + + { TSensForm } + + TSensForm = class(TForm) + AllBtn: TBitBtn; + AlphaEdit: TEdit; + Bevel1: TBevel; + CancelBtn: TButton; + Memo1: TLabel; + ResetBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + InBtn: TBitBtn; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + SelectedList: TListBox; + OutBtn: TBitBtn; + VarList: TListBox; + PrtRanksChk: TCheckBox; + PrtSlopesChk: TCheckBox; + PrtDataChk: TCheckBox; + GroupBox3: TGroupBox; + SlopesChk: TCheckBox; + PlotChk: TCheckBox; + GroupBox2: TGroupBox; + StandardizeChk: TCheckBox; + AvgSlopeChk: TCheckBox; + GroupBox1: TGroupBox; + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + SensForm: TSensForm; + +implementation + +uses + Math; + +{ TSensForm } + +procedure TSensForm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + AlphaEdit.Text := '0.05'; + StandardizeChk.Checked := false; + PlotChk.Checked := false; + SlopesChk.Checked := false; + InBtn.Enabled := true; + OutBtn.Enabled := false; + AvgSlopeChk.Checked := false; + SelectedList.Clear; + VarList.Clear; + for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TSensForm.InBtnClick(Sender: TObject); +VAR index, i : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + SelectedList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + OutBtn.Enabled := true; +end; + +procedure TSensForm.AllBtnClick(Sender: TObject); +VAR count, i : integer; +begin + count := VarList.Items.Count; + if count <= 0 then exit; + for i := 0 to VarList.Items.Count-1 do + SelectedList.Items.Add(VarList.Items.Strings[i]); + VarList.Clear; + OutBtn.Enabled := true; + InBtn.Enabled := false; +end; + +procedure TSensForm.ComputeBtnClick(Sender: TObject); +VAR + NoVars, noselected, count, half, q, tp, low, hi, col : integer; + Values, Slopes, AvgSlopes : DblDyneMat; + RankedQ, Sorted : DblDyneVec; + RowLabels, ColLabels, RankLabels : StrDyneVec; + selected : IntDyneVec; + temp, MedianSlope, MannKendall, Z, C, M1, M2, Alpha, mean, stddev : double; + cellstring, outline : string; + i, j, k, no2do : integer; + Standardize, Plot, SlopePlot, AvgSlope : boolean; + +begin + Standardize := false; + Plot := false; + SlopePlot := false; + AvgSlope := false; + + if StandardizeChk.Checked then Standardize := true; + if PlotChk.Checked then Plot := true; + if SlopesChk.Checked then SlopePlot := true; + if AvgSlopeChk.Checked then AvgSlope := true; + Alpha := 1.0 - StrToFloat(AlphaEdit.Text); + noselected := SelectedList.Items.Count; + if noselected = 0 then + begin + ShowMessage('ERROR! First select variables to analyze.'); + exit; + end; + SetLength(RowLabels,NoCases); + SetLength(ColLabels,NoCases); + SetLength(selected,noselected); + SetLength(Values,NoCases,noselected+1); + SetLength(Slopes,NoCases,NoCases); + SetLength(RankedQ,NoVars); + SetLength(Sorted,NoCases); + SetLength(AvgSlopes,NoCases,NoCases); + + for i := 0 to NoCases-1 do + begin + RowLabels[i] := OS3MainFrm.DataGrid.Cells[0,i+1]; + ColLabels[i] := RowLabels[i]; + for j := 0 to NoCases-1 do Slopes[i,j] := 0.0; + end; + + // get selected variables + for i := 1 to noselected do + begin + cellstring := SelectedList.Items.Strings[i-1]; + for j := 1 to NoVariables do + if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then + selected[i-1] := j; + end; + + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Sens Detection and Estimation of Trends'); + outline := format('Number of data points = %d, Confidence Interval = %4.2f', + [NoCases,Alpha]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + //Get the data + if AvgSlope then for i := 0 to NoCases-1 do Values[i,noselected] := 0.0; + for j := 0 to noselected-1 do + begin + col := selected[j]; + for i := 1 to NoCases do + begin + Values[i-1,j] := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i]))); + if AvgSlope then Values[i-1,noselected] := Values[i-1,noselected] + + Values[i-1,j]; + end; + end; + + if PrtDataChk.Checked then + begin + outline:= 'CASE'; + MAT_PRINT(Values,NoCases,noselected,outline,RowLabels,ColLabels,NoCases); + OutputFrm.ShowModal; + end; + + // standardize if more than one variable and standardization elected + if (noselected > 1) and (standardize = true) then + begin + for j := 0 to noselected-1 do + begin + mean := 0.0; + stddev := 0.0; + for i := 0 to NoCases-1 do + begin + mean := mean + Values[i,j]; + stddev := stddev + (Values[i,j] * Values[i,j]); + end; + stddev := stddev - (mean * mean) / NoCases; + stddev := stddev / (NoCases - 1); + stddev := sqrt(stddev); + mean := mean / NoCases; + for i := 0 to NoCases-1 do + Values[i,j] := (Values[i,j] - mean)/ stddev; + col := selected[j]; + outline := format('Variable = %s, mean = %8.3f, standard deviation = %8.3f', + [OS3MainFrm.DataGrid.Cells[col,0],mean,stddev]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + + // average the values if elected + if AvgSlope then for i := 0 to NoCases - 1 do Values[i,noselected] := + Values[i,noselected] / noselected; + + // get interval slopes + no2do := noselected; + if AvgSlope then no2do := no2do + 1; + for j := 0 to no2do - 1 do + begin + if j < noselected then + begin + col := selected[j]; + cellstring := OS3MainFrm.DataGrid.Cells[col,0]; + end + else + begin + col := 0; + cellstring := 'Combined Scores'; + end; + for i := 0 to NoCases-2 do + begin + for k := i + 1 to NoCases-1 do + Slopes[i,k] := (Values[k,j] - Values[i,j]) / (k-i); + end; + if PrtSlopesChk.Checked then + begin + outline := 'CASE'; + MAT_PRINT(Slopes,NoCases,NoCases,outline,RowLabels,ColLabels,NoCases); + end; + + // get ranked slopes and median estimator + count := 0; + for i := 0 to NoCases-2 do + begin + for k := i+1 to NoCases-1 do + begin + RankedQ[count] := Slopes[i,k]; + count := count + 1; + end; + end; + + //sort into ascending order + for i := 0 to count - 2 do + begin + for k := i + 1 to count-1 do + begin + if RankedQ[i] > RankedQ[k] then + begin + temp := RankedQ[i]; + RankedQ[i] := RankedQ[k]; + RankedQ[k] := temp; + end; + end; + end; + + if PrtRanksChk.Checked then + begin + SetLength(RankLabels,count); + for k := 0 to count-1 do RankLabels[k] := IntToStr(k+1); + OutputFrm.RichEdit.Lines.Add('Ranked Slopes'); + for i := 0 to count-1 do + begin + outline := format('Label = %s, Ranked Q = %8.3f', + [RankLabels[i],RankedQ[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; + RankLabels := nil; + end; + + // get median slope + half := count div 2; + if (2 * half) < count then MedianSlope := RankedQ[half] + else MedianSlope := (RankedQ[half-1] + RankedQ[half]) / 2.0; + + // get Mann-Kendall statistic based on tied values + for i := 0 to NoCases-1 do Sorted[i] := Values[i,j]; + for i := 0 to NoCases-2 do + begin + for k := i+1 to NoCases-1 do + begin + if Sorted[i] > Sorted[k] then + begin + temp := Sorted[i]; + Sorted[i] := Sorted[k]; + Sorted[k] := temp; + end; + end; + end; + + MannKendall := 0.0; + q := 0; + i := -1; + while (i < NoCases-2) do + begin + i := i + 1; + tp := 1; // no. of ties for pth (i) value + for k := i + 1 to NoCases-1 do + begin + if Sorted[k] <> Sorted[i] then + begin + i := k-1; + break; + end + else tp := tp + 1; + end; // next k + if tp > 1 then + begin + q := q + 1; + MannKendall := MannKendall + (tp * (tp-1) * (2 * tp + 5)); + end; + end; // end next i + MannKendall := (NoCases * (NoCases-1) * (2 * NoCases + 5) - + MannKendall) / 18.0; + Z := inversez(Alpha); + if MannKendall > 0 then + begin + C := Z * sqrt(MannKendall); + M1 := (count - C) / 2.0; + M2 := (count + C) / 2.0; + end + else begin + outline := format('Error: z = %8.3f, Mann-Kendall = %8.3f', + [Z,MannKendall]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + + // show results + if j < noselected then + begin + outline := format('Results for %s',[cellstring]); + OutputFrm.RichEdit.Lines.Add(outline); + end + else + OutputFrm.RichEdit.Lines.Add('Results for Averaged Values'); + if (noselected > 1) and (Standardize = true) then + begin + mean := 0.0; + stddev := 0.0; + for i := 0 to NoCases-1 do + begin + mean := mean + Values[i,j]; + stddev := stddev + (Values[i,j] * Values[i,j]); + end; + stddev := stddev - (mean * mean) / NoCases; + stddev := stddev / (NoCases - 1); + stddev := sqrt(stddev); + mean := mean / NoCases; + outline := format('Mean = %8.3f, Standard Deviation = %8.3f', + [mean,stddev]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := format('Median Slope for %d values = %8.3f', + [count,MedianSlope]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Mann-Kendall Variance statistic = %8.3f (%d ties)', + [MannKendall,q]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Ranks of the lower and upper confidence = %8.3f, %8.3f', + [M1, M2+1]); + OutputFrm.RichEdit.Lines.Add(outline); + low := round(M1 - 1.0); + if ((M1-1) - low) > 0.5 then low := round(M1-1); + hi := round(M2); + if (M2 - hi) > 0.5 then hi := round(M2); + if (low > 0) or (hi <= count) then + begin + outline := format('Corresponding lower and upper slopes = %8.3f, %8.3f', + [RankedQ[low],RankedQ[hi]]); + OutputFrm.RichEdit.Lines.Add(outline); + end + else begin + outline := format('ERROR! low rank = %d, hi rank = %d', + [low, hi]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + + // plot slopes if elected + if Plot then + begin + SetLength(GraphFrm.Xpoints,1,NoCases+1); + SetLength(GraphFrm.Ypoints,1,NoCases+1); + GraphFrm.GraphType := 2; + GraphFrm.nosets := 1; + GraphFrm.nbars := NoCases; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlue; + GraphFrm.FloorColor := clGray; + if j < noselected then GraphFrm.Heading := OS3MainFrm.DataGrid.Cells[col,0] + else GraphFrm.Heading := 'Average Values'; + GraphFrm.barwideprop := 1.0; + GraphFrm.AutoScaled := true; + GraphFrm.ShowLeftWall := true; + GraphFrm.ShowRightWall := true; + GraphFrm.ShowBottomWall := true; + GraphFrm.YTitle := 'Measure'; + GraphFrm.XTitle := 'Time'; + for k := 0 to NoCases - 1 do + begin + GraphFrm.Ypoints[0,k] := Values[k,j]; + GraphFrm.Xpoints[0,k] := k+1; + end; + GraphFrm.ShowModal; + GraphFrm.Ypoints := nil; + GraphFrm.Xpoints := nil; + end; + + // plot ranked slopes if elected + if SlopePlot then + begin + SetLength(GraphFrm.Xpoints,1,count+1); + SetLength(GraphFrm.Ypoints,1,count+1); + GraphFrm.GraphType := 2; + GraphFrm.nosets := 1; + GraphFrm.nbars := count; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlue; + GraphFrm.FloorColor := clGray; + GraphFrm.Heading := 'Ranked Slopes'; + GraphFrm.barwideprop := 1.0; + GraphFrm.AutoScaled := true; + GraphFrm.ShowLeftWall := true; + GraphFrm.ShowRightWall := true; + GraphFrm.ShowBottomWall := true; + GraphFrm.YTitle := 'Slope'; + GraphFrm.XTitle := 'Rank'; + for k := 0 to count - 1 do + begin + GraphFrm.Ypoints[0,k] := RankedQ[k]; + GraphFrm.Xpoints[0,k] := k+1; + end; + GraphFrm.ShowModal; + GraphFrm.Ypoints := nil; + GraphFrm.Xpoints := nil; + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + end; // next variable j + + if AvgSlope then + begin + for i := 0 to NoCases-2 do + begin + for k := i + 1 to NoCases-1 do + begin + AvgSlopes[i,k] := AvgSlopes[i,k] + Slopes[i,k]; + end; + end; + end; + + // Average multiple measures + if AvgSlope then + begin + OutputFrm.RichEdit.Lines.Add('Results for Averaged Slopes'); + for i := 0 to NoCases-2 do + begin + for k := i + 1 to NoCases-1 do + AvgSlopes[i,k] := AvgSlopes[i,k] / noselected; + end; + + // get ranked slopes and median estimator + count := 0; + for i := 0 to NoCases-2 do + begin + for j := i + 1 to NoCases-1 do + begin + RankedQ[count] := AvgSlopes[i,j]; + count := count + 1; + end; + end; + for i := 0 to Count-2 do + begin + for j := i + 1 to count - 1 do + begin + if RankedQ[i] > RankedQ[j] then + begin + temp := RankedQ[i]; + RankedQ[i] := RankedQ[j]; + RankedQ[j] := temp; + end; + end; + end; + // get median slope + half := count div 2; + if (2 * half) < count then MedianSlope := RankedQ[half + 1] + else MedianSlope := (RankedQ[half] + RankedQ[half+1]) / 2.0; + // get Mann-Kendall statistic based on tied values + MannKendall := 0.0; + q := 0; + i := -1; + while (i < count-1) do + begin + i := i + 1; + tp := 1; // no. of ties for pth (i) value + for j := i + 1 to count-1 do + begin + if RankedQ[j] <> RankedQ[i] then + begin + i := j - 1; + break; + end + else tp := tp + 1; + end; + if tp > 1 then + begin + q := q + 1; + MannKendall := MannKendall + (tp * (tp-1) * (2 * tp + 5)); + end; + end; // end do while + MannKendall := (NoCases * (NoCases-1) * (2 * NoCases + 5) - MannKendall) / 18.0; + Z := inversez(Alpha); + if MannKendall < 0.0 then + begin + outline := format('Error in calculating Mann-Kendall = %8.3f', + [MannKendall]); + ShowMessage(outline); + end; + if MannKendall > 0.0 then C := Z * sqrt(MannKendall) + else C := Z; + M1 := (count - C) / 2.0; + M2 := (count + C) / 2.0; + // Show results + outline := format('Median Slope for %d values = %8.3f for averaged measures', + [count,MedianSlope]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Mann-Kendall Variance statistic = %8.3f (%d ties observed)', + [MannKendall,q]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Ranks of the lower and upper confidence = (%8.3f, %8.3f)', + [M1, M2]); + OutputFrm.RichEdit.Lines.Add(outline); + low := round(M1) - 1; + if ((M1-1) - low) > 0.5 then low := round(M1 - 1); + hi := round(M2); + if (M2 - hi) > 0.5 then hi := round(M2); + outline := format('Corresponding lower and upper slopes = (%8.3f, %8.3f)', + [RankedQ[low],RankedQ[hi]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; // end if average slope + OutputFrm.ShowModal; + + // cleanup + AvgSlopes := nil; + Sorted := nil; + RankedQ := nil; + Slopes := nil; + Values := nil; + selected := nil; + ColLabels := nil; + RowLabels := nil; +end; + +procedure TSensForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TSensForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TSensForm.OutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := SelectedList.ItemIndex; + VarList.Items.Add(SelectedList.Items.Strings[index]); + SelectedList.Items.Delete(index); + InBtn.Enabled := true; + if SelectedList.Items.Count = 0 then OutBtn.Enabled := false; +end; + +initialization + {$I sensunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/signtestunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/signtestunit.lfm new file mode 100644 index 000000000..49fa5fdd1 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/signtestunit.lfm @@ -0,0 +1,236 @@ +object SignTestFrm: TSignTestFrm + Left = 550 + Height = 372 + Top = 297 + Width = 391 + AutoSize = True + Caption = 'The Matched Pairs Sign Test' + ClientHeight = 372 + ClientWidth = 391 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables Available' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Var1Edit + AnchorSideBottom.Control = Var1Edit + Left = 217 + Height = 15 + Top = 33 + Width = 50 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Variable 1' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Var2Edit + AnchorSideBottom.Control = Var2Edit + Left = 217 + Height = 15 + Top = 125 + Width = 50 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Variable 2' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Var1In + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 298 + Top = 25 + Width = 165 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object Var1In: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 181 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Var1InClick + Spacing = 0 + TabOrder = 1 + end + object Var1Out: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Var1In + AnchorSideTop.Side = asrBottom + Left = 181 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Var1OutClick + Spacing = 0 + TabOrder = 2 + end + object Var2In: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Var1Out + AnchorSideTop.Side = asrBottom + Left = 181 + Height = 28 + Top = 117 + Width = 28 + BorderSpacing.Top = 32 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Var2InClick + Spacing = 0 + TabOrder = 4 + end + object Var2Out: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Var2In + AnchorSideTop.Side = asrBottom + Left = 181 + Height = 28 + Top = 149 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Var2OutClick + Spacing = 0 + TabOrder = 5 + end + object Var1Edit: TEdit + AnchorSideLeft.Control = Var1In + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Var1Out + AnchorSideBottom.Side = asrBottom + Left = 217 + Height = 23 + Top = 50 + Width = 166 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'Var1Edit' + end + object Var2Edit: TEdit + AnchorSideLeft.Control = Var2In + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Var2Out + AnchorSideBottom.Side = asrBottom + Left = 217 + Height = 23 + Top = 142 + Width = 166 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'Var2Edit' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 182 + Height = 25 + Top = 339 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 7 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 244 + Height = 25 + Top = 339 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 8 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 328 + Height = 25 + Top = 339 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 9 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 323 + Width = 391 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/signtestunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/signtestunit.pas new file mode 100644 index 000000000..5ea645549 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/signtestunit.pas @@ -0,0 +1,283 @@ +unit SignTestUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, Globals, DataProcs; + +type + + { TSignTestFrm } + + TSignTestFrm = class(TForm) + Bevel1: TBevel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + Var1In: TBitBtn; + Var1Out: TBitBtn; + Var2In: TBitBtn; + Var2Out: TBitBtn; + Var1Edit: TEdit; + Var2Edit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure Var1InClick(Sender: TObject); + procedure Var1OutClick(Sender: TObject); + procedure Var2InClick(Sender: TObject); + procedure Var2OutClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + SignTestFrm: TSignTestFrm; + +implementation + +uses + Math; + +{ TSignTestFrm } + +procedure TSignTestFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + Var1Edit.Text := ''; + Var2Edit.Text := ''; + VarList.Items.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TSignTestFrm.Var1InClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (Var1Edit.Text = '') then + begin + Var1Edit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TSignTestFrm.Var1OutClick(Sender: TObject); +begin + if Var1Edit.Text <> '' then + begin + VarList.Items.Add(Var1Edit.Text); + Var1Edit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TSignTestFrm.Var2InClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (Var2Edit.Text = '') then + begin + Var2Edit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TSignTestFrm.Var2OutClick(Sender: TObject); +begin + if Var2Edit.Text <> '' then + begin + VarList.Items.Add(Var2Edit.Text); + Var2Edit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TSignTestFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TSignTestFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := 4*w; //Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TSignTestFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TSignTestFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TSignTestFrm.ComputeBtnClick(Sender: TObject); +var + i, k, col1, col2, X, N, A, b, Temp : integer; + ColNoSelected : IntDyneVec; + DifSigns : IntDyneVec; + p, Q, Probability, z, NoDiff, CorrectedA, x1, x2 : double; + SumProb : double; + cellstring, outline : string; + lReport: TStrings; +begin + if Var1Edit.Text = '' then + begin + MessageDlg('Variable 1 not selected.', mtError, [mbOK], 0); + exit; + end; + + if Var2Edit.Text = '' then + begin + MessageDlg('Variable 2 not selected.', mtError, [mbOK], 0); + exit; + end; + + SumProb := 0.0; + SetLength(DifSigns,NoCases); + SetLength(ColNoSelected,NoVariables); + k := 2; + + // Get column numbers and labels of variables selected + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = Var1Edit.Text then ColNoSelected[0] := i; + if cellstring = Var2Edit.Text then ColNoSelected[1] := i; + end; + + p := 0.5; + Q := 0.5; + + // Get sign of difference between pairs '(-1 := - ; 0 := no difference; +1 := + + A := 0; + b := 0; + NoDiff := 0.0; + for i := 1 to NoCases do + begin + if (not GoodRecord(i,k,ColNoSelected)) then continue; + col1 := ColNoSelected[0]; + col2 := ColNoSelected[1]; + x1 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col1,i])); + x2 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col2,i])); + if (x1 > x2) then + begin + DifSigns[i-1] := 1; + A := A + 1; + end; + if (x1 < x2) then + begin + DifSigns[i-1] := -1; + b := b + 1; + end; + if (x1 = x2) then + begin + DifSigns[i-1] := 0; + NoDiff := NoDiff + 1.0; + end; + end; + + // Show results + lReport := TStringList.Create; + try + lReport.Add('RESULTS FOR THE SIGN TEST'); + lReport.Add(''); + lReport.Add('Frequency of %d out of %d observed + sign differences.', [A, NoCases]); + lReport.Add('Frequency of %d out of %d observed - sign differences.', [b, NoCases]); + lReport.Add('Frequency of %.0f out of %d observed no differences.', [NoDiff, NoCases]); + lReport.Add(''); + lReport.Add('The theoretical proportion expected for +''s or -''s is 0.5 '); + lReport.Add('The test is for the probability of the +''s or -''s (which ever is fewer)');; + lReport.Add('as small or smaller than that observed given the expected proportion.'); + lReport.Add(''); + + // Swap A and B around if A > B + if (A > b) then + begin + Temp := A; + A := b; + b := Temp; + end; + + N := A + b; + if (N > 25) then // Use normal distribution approximation + begin + CorrectedA := A; + if (A < N * p) then CorrectedA := A + 0.5; + if (A > N * p) then CorrectedA := A - 0.5; + z := (CorrectedA - N * p) / sqrt(N * p * Q); + lReport.Add('Z value for Normal Distribution approximation: %.3f', [z]); + Probability := probz(z); + lReport.Add('Probability: %.4f', [Probability]); + end + else // Use binomial fomula + begin + X := 0; + while X <= A do + begin + Probability := combos(X, N) * Power(p,X) * Power(Q,(N - X)); + lReport.Add('Binary Probability of %3d: %6.4f', [X, Probability]); + SumProb := SumProb + Probability; + X := X + 1; + end; + lReport.Add('Binomial Probability of %d or smaller out of %d: %.4f', [A, N, SumProb]); + end; + + DisplayReport(lReport); + finally + lReport.Free; + DifSigns := nil; + ColNoSelected := nil; + end; +end; + +procedure TSignTestFrm.UpdateBtnStates; +begin + Var1In.Enabled := (VarList.ItemIndex > -1) and (Var1Edit.Text = ''); + Var2In.Enabled := (VarList.ItemIndex > -1) and (Var2Edit.Text = ''); + Var1Out.Enabled := (Var1Edit.Text <> ''); + Var2Out.Enabled := (Var2Edit.Text <> ''); +end; + + +initialization + {$I signtestunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/simplechisqrunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/simplechisqrunit.lfm new file mode 100644 index 000000000..7bd6b7a07 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/simplechisqrunit.lfm @@ -0,0 +1,357 @@ +object SimpleChiSqrForm: TSimpleChiSqrForm + Left = 827 + Height = 436 + Top = 221 + Width = 408 + Caption = 'Simple ChiSquare for Categories' + ClientHeight = 436 + ClientWidth = 408 + OnActivate = FormActivate + OnCreate = FormCreate + OnResize = FormResize + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideTop.Control = NcatsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NcatsEdit + Left = 168 + Height = 30 + Top = 65 + Width = 166 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Enter the number of categories:'#13#10'Click the mouse after entering.' + ParentColor = False + end + object NcatsEdit: TEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 342 + Height = 23 + Top = 69 + Width = 58 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 16 + OnClick = NcatsEditExit + OnExit = NcatsEditExit + TabOrder = 0 + Text = '1' + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 251 + Height = 25 + Top = 403 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 185 + Height = 25 + Top = 403 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 4 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 339 + Height = 25 + Top = 403 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 6 + end + object Label5: TLabel + AnchorSideTop.Control = TotChiSqrEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = TotChiSqrEdit + Left = 152 + Height = 15 + Top = 341 + Width = 96 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Total ChiSquare = ' + ParentColor = False + end + object TotChiSqrEdit: TEdit + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ProbEdit + Left = 256 + Height = 23 + Top = 337 + Width = 144 + Alignment = taRightJustify + Anchors = [akRight, akBottom] + BorderSpacing.Top = 12 + BorderSpacing.Bottom = 4 + ReadOnly = True + TabOrder = 2 + end + object Label6: TLabel + AnchorSideTop.Control = ProbEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ProbEdit + Left = 172 + Height = 15 + Top = 368 + Width = 76 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Probability >=' + ParentColor = False + end + object ProbEdit: TEdit + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 256 + Height = 23 + Top = 364 + Width = 144 + Alignment = taRightJustify + Anchors = [akRight, akBottom] + BorderSpacing.Top = 3 + ReadOnly = True + TabOrder = 3 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 387 + Width = 408 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 45 + Top = 8 + Width = 392 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Around = 8 + Caption = 'This procedure lets you enter the number of observed values and the number of expected values for one or more categories. Enter the values as indicated and when finished, press the compute button.' + ParentColor = False + WordWrap = True + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = NcatsEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = TotChiSqrEdit + Left = 8 + Height = 217 + Top = 108 + Width = 392 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 24 + ChildSizing.EnlargeHorizontal = crsScaleChilds + ChildSizing.EnlargeVertical = crsScaleChilds + ChildSizing.ShrinkHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 3 + ClientHeight = 217 + ClientWidth = 392 + TabOrder = 1 + object Panel2: TPanel + Left = 0 + Height = 217 + Top = 0 + Width = 115 + BevelOuter = bvNone + ClientHeight = 217 + ClientWidth = 115 + TabOrder = 0 + object Label2: TLabel + AnchorSideLeft.Control = Panel2 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel2 + Left = 18 + Height = 15 + Top = 0 + Width = 79 + BorderSpacing.Left = 8 + Caption = 'Freq. Observed' + Constraints.MinHeight = 15 + ParentColor = False + end + object ObservedGrid: TStringGrid + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 200 + Top = 17 + Width = 115 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoFillColumns = True + BorderSpacing.Top = 2 + ColCount = 1 + Constraints.MinHeight = 200 + FixedCols = 0 + MouseWheelOption = mwGrid + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goThumbTracking, goSmoothScroll] + RowCount = 2 + TabOrder = 0 + ColWidths = ( + 111 + ) + end + end + object Panel3: TPanel + Left = 139 + Height = 217 + Top = 0 + Width = 115 + BevelOuter = bvNone + ClientHeight = 217 + ClientWidth = 115 + TabOrder = 1 + object Label3: TLabel + AnchorSideLeft.Control = Panel3 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel3 + Left = 17 + Height = 15 + Top = 0 + Width = 80 + Caption = 'Freq. Expected:' + Constraints.MaxHeight = 15 + ParentColor = False + end + object ExpectedGrid: TStringGrid + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel3 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 200 + Top = 17 + Width = 115 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoFillColumns = True + BorderSpacing.Top = 2 + ColCount = 1 + FixedCols = 0 + MouseWheelOption = mwGrid + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goThumbTracking, goSmoothScroll] + RowCount = 2 + TabOrder = 0 + ColWidths = ( + 111 + ) + end + end + object Panel4: TPanel + AnchorSideBottom.Side = asrBottom + Left = 278 + Height = 217 + Top = 0 + Width = 114 + BevelOuter = bvNone + ClientHeight = 217 + ClientWidth = 114 + TabOrder = 2 + object Label4: TLabel + AnchorSideLeft.Control = Panel4 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel4 + AnchorSideRight.Side = asrBottom + Left = 11 + Height = 15 + Top = 0 + Width = 93 + BorderSpacing.Right = 8 + Caption = 'Computed Values' + ParentColor = False + end + object ChiSqrGrid: TStringGrid + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel4 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel4 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 200 + Top = 17 + Width = 114 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoFillColumns = True + BorderSpacing.Top = 2 + ColCount = 1 + FixedCols = 0 + MouseWheelOption = mwGrid + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goAlwaysShowEditor, goThumbTracking, goSmoothScroll] + RowCount = 2 + TabOrder = 0 + ColWidths = ( + 110 + ) + end + end + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/simplechisqrunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/simplechisqrunit.pas new file mode 100644 index 000000000..e592c9688 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/simplechisqrunit.pas @@ -0,0 +1,161 @@ +unit SimpleChiSqrUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Grids, ExtCtrls, + MainUnit, Globals, FunctionsLib, OutputUnit; + +type + + { TSimpleChiSqrForm } + + TSimpleChiSqrForm = class(TForm) + Bevel1: TBevel; + ComputeBtn: TButton; + Memo1: TLabel; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + Panel4: TPanel; + ProbEdit: TEdit; + Label6: TLabel; + TotChiSqrEdit: TEdit; + Label5: TLabel; + ResetBtn: TButton; + ReturnBtn: TButton; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + NcatsEdit: TEdit; + Label1: TLabel; + ObservedGrid: TStringGrid; + ExpectedGrid: TStringGrid; + ChiSqrGrid: TStringGrid; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormResize(Sender: TObject); + procedure NcatsEditExit(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + NoCats: integer; + public + { public declarations } + end; + +var + SimpleChiSqrForm: TSimpleChiSqrForm; + +implementation + +uses + Math; + +{ TSimpleChiSqrForm } + +procedure TSimpleChiSqrForm.NcatsEditExit(Sender: TObject); +begin + NoCats := StrToInt(NcatsEdit.Text); + ObservedGrid.RowCount := NoCats+1; + ExpectedGrid.RowCount := NoCats+1; + ChiSqrGrid.RowCount := NoCats+1; +end; + +procedure TSimpleChiSqrForm.ComputeBtnClick(Sender: TObject); +var + TotalChiSqr : double; + ChiSqr, Obs, Exp, ChiProb, NObs, NExp : double; + i : integer; + outline : string; +begin + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Simple Chi-Square Analysis Results'); + OutputFrm.RichEdit.Lines.Add('Category ChiSquare'); + TotalChiSqr := 0.0; + NObs := 0.0; + NExp := 0.0; + for i := 1 to NoCats do + begin + Obs := StrToFloat(ObservedGrid.Cells[0,i]); + NObs := NObs + 1; + Exp := StrToFloat(ExpectedGrid.Cells[0,i]); + NExp := NExp + 1; + chisqr := sqr(Obs - Exp) / Exp; + outline := format('%8.3f',[chisqr]); + ChiSqrGrid.Cells[0,i] := outline; + TotalChiSqr := TotalChiSqr + chisqr; + outline := format(' %2d %8.3f',[i,chisqr]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.RichEdit.Lines.Add(''); + TotChiSqrEdit.Text := FloatToStr(TotalChiSqr); + ChiProb := 1.0 - ChiSquaredProb(TotalChiSqr,NoCats); + ProbEdit.Text := FloatToStr(ChiProb); + outline := format('Number Observed = %8.3f',[NObs]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Number Expected = %8.3f',[NExp]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('ChiSquare = %8.3f with Probability of a larger value = %8.3f', + [TotalChiSqr,ChiProb]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; +end; + +procedure TSimpleChiSqrForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + FAutoSized := true; +end; + +procedure TSimpleChiSqrForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TSimpleChiSqrForm.FormResize(Sender: TObject); +var + w: Integer; + dist: Integer; +begin + dist := ObservedGrid.BorderSpacing.Left + ChiSqrGrid.BorderSpacing.Right; + w := Width div 3 - dist; + ObservedGrid.Width := w; + ExpectedGrid.Width := w; + ChiSqrGrid.Width := w; +end; + +procedure TSimpleChiSqrForm.ResetBtnClick(Sender: TObject); +begin + NoCats := 1; + ObservedGrid.RowCount := NoCats + 1; + ExpectedGrid.RowCount := NoCats + 1; + ChiSqrGrid.RowCount := NoCats + 1; + NCatsEdit.Text := '1'; + ObservedGrid.Cells[0,0] := 'Observed'; + ExpectedGrid.Cells[0,0] := 'Expected'; + ChiSqrGrid.Cells[0,0] := 'ChiSquared'; +end; + +initialization + {$I simplechisqrunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/spearmanunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/spearmanunit.lfm new file mode 100644 index 000000000..ec8907a17 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/spearmanunit.lfm @@ -0,0 +1,246 @@ +object SpearmanFrm: TSpearmanFrm + Left = 531 + Height = 317 + Top = 246 + Width = 347 + AutoSize = True + Caption = 'Spearman Rank Correlation' + ClientHeight = 317 + ClientWidth = 347 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables Available' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = XEdit + AnchorSideBottom.Control = XEdit + Left = 233 + Height = 15 + Top = 33 + Width = 51 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'X Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = YEdit + AnchorSideBottom.Control = YEdit + Left = 233 + Height = 15 + Top = 125 + Width = 51 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Y Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = XIn + AnchorSideBottom.Control = Bevel1 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 243 + Top = 25 + Width = 181 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object XIn: TBitBtn + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + Left = 197 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = XInClick + Spacing = 0 + TabOrder = 1 + end + object XOut: TBitBtn + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = XIn + AnchorSideTop.Side = asrBottom + Left = 197 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = XOutClick + Spacing = 0 + TabOrder = 2 + end + object YIn: TBitBtn + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = XOut + AnchorSideTop.Side = asrBottom + Left = 197 + Height = 28 + Top = 117 + Width = 28 + BorderSpacing.Top = 32 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = YInClick + Spacing = 0 + TabOrder = 3 + end + object YOut: TBitBtn + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = YIn + AnchorSideTop.Side = asrBottom + Left = 197 + Height = 28 + Top = 149 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = YOutClick + Spacing = 0 + TabOrder = 4 + end + object XEdit: TEdit + AnchorSideLeft.Control = XIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = XOut + AnchorSideBottom.Side = asrBottom + Left = 233 + Height = 23 + Top = 50 + Width = 106 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 5 + Text = 'XEdit' + end + object YEdit: TEdit + AnchorSideLeft.Control = YOut + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = YOut + AnchorSideBottom.Side = asrBottom + Left = 233 + Height = 23 + Top = 142 + Width = 106 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'YEdit' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 138 + Height = 25 + Top = 284 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 7 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 200 + Height = 25 + Top = 284 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 8 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 284 + Height = 25 + Top = 284 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 9 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ComputeBtn + Left = 0 + Height = 8 + Top = 268 + Width = 347 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 150 + Height = 11 + Top = 3 + Width = 47 + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/spearmanunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/spearmanunit.pas new file mode 100644 index 000000000..bc582b1c0 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/spearmanunit.pas @@ -0,0 +1,470 @@ +unit SpearmanUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, Globals, DataProcs; + +type + + { TSpearmanFrm } + + TSpearmanFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + XIn: TBitBtn; + XOut: TBitBtn; + YIn: TBitBtn; + YOut: TBitBtn; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + XEdit: TEdit; + YEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + procedure XInClick(Sender: TObject); + procedure XOutClick(Sender: TObject); + procedure YInClick(Sender: TObject); + procedure YOutClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + SpearmanFrm: TSpearmanFrm; + +implementation + +uses + Math; + +{ TSpearmanFrm } + +procedure TSpearmanFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + XEdit.Text := ''; + YEdit.Text := ''; + VarList.Items.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TSpearmanFrm.XInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (XEdit.Text = '') then + begin + XEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TSpearmanFrm.XOutClick(Sender: TObject); +begin + if XEdit.Text <> '' then + begin + VarList.Items.Add(XEdit.Text); + XEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TSpearmanFrm.YInClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (YEdit.Text = '') then + begin + YEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TSpearmanFrm.YOutClick(Sender: TObject); +begin + if YEdit.Text <> '' then + begin + VarList.Items.Add(YEdit.Text); + YEdit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TSpearmanFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TSpearmanFrm.ComputeBtnClick(Sender: TObject); +var + i, j, itemp, NoTies, NoSelected : integer; + col1, col2, NCases : integer; + index : IntDyneMat; + Probability, sumsqrx, sumsqry, Temp, TieSum, Avg, t, SumT, r : double; + z, sumdsqr, df : double; + Ranks, X : DblDyneMat; + d : DblDyneVec; + cellstring: string; + ColNoSelected : IntDyneVec; + ColLabels : StrDyneVec; + VarX, VarY, SDX, SDY, MeanX, MeanY, Rxy : double; + lReport: TStrings; +begin + if (XEdit.Text = '') then begin + MessageDlg('X variable is not selected.', mtError, [mbOK], 0); + exit; + end; + if (YEdit.Text = '') then begin + MessageDlg('Y variable is not selected.', mtError, [mbOK], 0); + exit; + end; + + // Allocate memory + SetLength(ColNoSelected, NoVariables); + SetLength(index, NoCases, 2); + SetLength(Ranks, NoCases, 2); + SetLength(X, NoCases, 2); + SetLength(d, NoCases); + SetLength(ColLabels, NoVariables); + + // Get column numbers and labels of variables selected + for j := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[j,0]; + if cellstring = Xedit.Text then + begin + ColNoSelected[0] := j; + ColLabels[0] := cellstring; + end; + if cellstring = Yedit.Text then + begin + ColNoSelected[1] := j; + ColLabels[1] := cellstring; + end; + end; + NoSelected := 2; + + lReport := TStringList.Create; + try + lReport.Add('SPEARMAN RANK CORRELATION BETWEEN %s AND %s', [ColLabels[0], ColLabels[1]]);; + lReport.Add(''); + + // Get scores + NCases := 0; + MeanX := 0.0; + MeanY := 0.0; + VarX := 0.0; + VarY := 0.0; + Rxy := 0.0; + NoTies := 0; + + for i := 1 to NoCases do + begin + if ( not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + NCases := NCases + 1; + col1 := ColNoSelected[0]; + col2 := ColNoSelected[1]; + X[NCases-1,0] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col1,i])); + Ranks[NCases-1,0] := X[NCases-1,0]; + X[NCases-1,1] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col2,i])); + Ranks[NCases-1,1] := X[NCases-1,1]; + index[NCases-1,0] := NCases; + index[NCases-1,1] := NCases; + VarX := VarX + X[NCases-1,0] * X[NCases-1,0]; + VarY := VarY + X[NCases-1,1] * X[NCases-1,1]; + MeanX := MeanX + X[NCases-1,0]; + MeanY := MeanY + X[NCases-1,1]; + Rxy := Rxy + X[NCases-1,0] * X[NCases-1,1]; + end; + + // Rank the first variable + for i := 1 to NCases - 1 do + begin + for j := i + 1 to NCases do + begin + if (Ranks[i-1,0] > Ranks[j-1,0]) then // swap + begin + Temp := Ranks[i-1,0]; + Ranks[i-1,0] := Ranks[j-1,0]; + Ranks[j-1,0] := Temp; + itemp := index[i-1,0]; + index[i-1,0] := index[j-1,0]; + index[j-1,0] := itemp; + Temp := X[i-1,0]; + X[i-1,0] := X[j-1,0]; + X[j-1,0] := Temp; + end; + end; + end; + + // Assign ranks + for i := 1 to NCases do Ranks[i-1,0] := i; + + // Check for ties in each + // NoTieGroups := 0; + SumT := 0.0; + i := 1; + while (i < NCases) do + begin + j := i+1; + TieSum := 0.0; + NoTies := 0; + while (j <= NCases) do + begin + if (X[j-1,0] > X[i-1,0]) then + Break; + if (X[j-1,0] = X[i-1,0]) then + begin + TieSum := TieSum + Ranks[j-1,0]; + NoTies := NoTies + 1; + end; + j := j + 1; + end; + + if (NoTies > 0) then // at least one tie found + begin + TieSum := TieSum + Ranks[i-1,0]; + NoTies := NoTies + 1; + Avg := TieSum / NoTies; + for j := i to i + NoTies - 1 do Ranks[j-1,0] := Avg; + t := ( Power(NoTies,3) - NoTies) / 12.0; + SumT := SumT + t; + // NoTieGroups := NoTieGroups + 1; + i := i + (NoTies-1); + end; + i := i + 1; + end; + sumsqrx := ( (Power(NCases,3) - NCases) / 12.0) - SumT; + lReport.Add('Tied ranks correction for X = %8.2f for %d ties', [sumsqrx, NoTies]); + + // Repeat sort for second variable + for i := 1 to NCases - 1 do + begin + for j := i + 1 to NCases do + begin + if (Ranks[i-1,1] > Ranks[j-1,1]) then // swap + begin + Temp := Ranks[i-1,1]; + Ranks[i-1,1] := Ranks[j-1,1]; + Ranks[j-1,1] := Temp; + itemp := index[i-1,1]; + index[i-1,1] := index[j-1,1]; + index[j-1,1] := itemp; + Temp := X[i-1,1]; + X[i-1,1] := X[j-1,1]; + X[j-1,1] := Temp; + end; + end; + end; + + // Assign ranks + for i := 1 to NCases do Ranks[i-1,1] := i; + + // Check for ties in each + SumT := 0.0; + // NoTieGroups := 0; + i := 1; + while (i < NCases) do + begin + j := i+1; + TieSum := 0.0; + NoTies := 0; + while (j <= NCases) do + begin + if (X[j-1,1] > X[i-1,1]) then + Break; + if (X[j-1,1] = X[i-1,1]) then + begin + TieSum := TieSum + Ranks[j-1,1]; + NoTies := NoTies + 1; + end; + j := j + 1; + end; + + if (NoTies > 0) then // at least one tie found + begin + TieSum := TieSum + Ranks[i-1,1]; + NoTies := NoTies + 1; + Avg := TieSum / NoTies; + for j := i to i + NoTies - 1 do Ranks[j-1,1] := Avg; + t := ( Power(NoTies,3) - NoTies) / 12.0; + SumT := SumT + t; + // NoTieGroups := NoTieGroups + 1; + i := i + (NoTies-1); + end; + i := i + 1; + end; + sumsqry := ( (Power(NCases,3) - NCases) / 12.0) - SumT; + lReport.Add('Tied ranks correction for Y = %8.2f for %d ties', [sumsqry, NoTies]); + + // arrange scores in order of first variable + for i := 1 to Ncases - 1 do + begin + for j := i + 1 to Ncases do + begin + if (index[i-1,0] > index[j-1,0]) then // swap all + begin + itemp := index[i-1,0]; + index[i-1,0] := index[j-1,0]; + index[j-1,0] := itemp; + Temp := X[i-1,0]; + X[i-1,0] := X[j-1,0]; + X[j-1,0] := Temp; + Temp := Ranks[i-1,0]; + Ranks[i-1,0] := Ranks[j-1,0]; + Ranks[j-1,0] := Temp; + end; // end swap + end; // next j + end; // next i + + // arrange scores of the second variable + for i := 1 to Ncases - 1 do + begin + for j := i + 1 to Ncases do + begin + if (index[i-1,1] > index[j-1,1]) then // swap all + begin + itemp := index[i-1,1]; + index[i-1,1] := index[j-1,1]; + index[j-1,1] := itemp; + Temp := X[i-1,1]; + X[i-1,1] := X[j-1,1]; + X[j-1,1] := Temp; + Temp := Ranks[i-1,1]; + Ranks[i-1,1] := Ranks[j-1,1]; + Ranks[j-1,1] := Temp; + end; // end swap + end; // next j + end; // next i + + // Calculate difference scores + sumdsqr := 0.0; + for i := 1 to NCases do + begin + d[i-1] := Ranks[i-1,0] - Ranks[i-1,1]; + sumdsqr := sumdsqr + (d[i-1] * d[i-1]); + end; + + // Calculate corrected spearman rank correlation + r := (sumsqrx + sumsqry - sumdsqr) / (2.0 * sqrt(sumsqrx * sumsqry)); + + // Calculate Pearson correlation + VarX := VarX - (MeanX * MeanX) / NCases; + VarX := VarX / (NCases-1); + VarY := VarY - (MeanY * MeanY) / NCases; + VarY := VarY / (NCases - 1); + SDX := sqrt(VarX); + SDY := sqrt(VarY); + Rxy := Rxy - (MeanX * MeanY) / NCases; + Rxy := Rxy / (NCases - 1); + Rxy := Rxy / (SDX * SDY); + MeanX := MeanX / NCases; + MeanY := MeanY / NCases; + + // Output the results + lReport.Add(''); + lReport.Add('Observed scores, their ranks and differences between ranks'); + lReport.Add('CASE %10s Ranks %10s Ranks Rank Difference', [ColLabels[0], ColLabels[1]]); + for i := 1 to NCases do + lReport.Add('%4d %10.2f%10.2f%10.2f%10.2f%10.2f', + [i, X[i-1,0], Ranks[i-1,0], X[i-1,1], Ranks[i-1,1], d[i-1]]); + lReport.Add('Spearman Rank Correlation: %6.3f',[r]); + lReport.Add(''); + + if (NCases > 10) then// Use normal distribution approximation + begin + z := r * sqrt((NCases - 2) / (1.0 - (r * r))); + lReport.Add('t-test value for hypothesis r = 0 is %.3f', [z]); + df := NCases - 2; + Probability := probt(z,df); + lReport.Add('Probability > t: %6.4f', [Probability]); + end + else + lReport.Add('Use table P, page 284 in Siegel for testing significance of r.'); + + lReport.Add(''); + lReport.Add('Pearson r for original scores: %.3f', [Rxy]); + lReport.Add('For the Original Scores:'); + lReport.Add('Mean X Variance X Std.Dev. X Mean Y Variance Y Std.Dev. Y'); + lReport.Add('%8.2f %8.2f %8.2f %8.2f %8.2f %8.2f', [MeanX, VarX, SDX, MeanY, VarY, SDY]); + + DisplayReport(lReport); + + finally + lReport.Free; + + ColLabels := nil; + d := nil; + X := nil; + Ranks := nil; + index := nil; + ColNoSelected := nil; + end; +end; + +procedure TSpearmanFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := 4*w; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TSpearmanFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TSpearmanFrm.UpdateBtnStates; +begin + XIn.Enabled := (VarList.Count > 0) and (XEdit.Text = ''); + YIn.Enabled := (Varlist.Count > 0) and (YEdit.Text = ''); + XOut.Enabled := XEdit.Text <> ''; + YOut.Enabled := YEdit.Text <> ''; +end; + +procedure TSpearmanFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +initialization + {$I spearmanunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/srhtestunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/srhtestunit.lfm new file mode 100644 index 000000000..4ad496e9e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/srhtestunit.lfm @@ -0,0 +1,421 @@ +object SRHTest: TSRHTest + Left = 654 + Height = 631 + Top = 147 + Width = 471 + AutoSize = True + Caption = 'Scheirer-Ray-Hare Test' + ClientHeight = 631 + ClientWidth = 471 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 204 + Width = 49 + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + Caption = 'Variables:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Fact1In + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 361 + Top = 221 + Width = 205 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + TabOrder = 0 + end + object DepIn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 221 + Height = 28 + Top = 221 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = DepInClick + Spacing = 0 + TabOrder = 1 + end + object StaticText1: TStaticText + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = DepVar + Left = 257 + Height = 16 + Top = 228 + Width = 103 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Dependent Variable' + TabOrder = 3 + end + object DepVar: TEdit + AnchorSideLeft.Control = DepIn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = DepOut + AnchorSideBottom.Side = asrBottom + Left = 257 + Height = 23 + Top = 246 + Width = 206 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 4 + Text = 'DepVar' + end + object Fact1In: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepOut + AnchorSideTop.Side = asrBottom + Left = 221 + Height = 28 + Top = 301 + Width = 28 + BorderSpacing.Top = 20 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Fact1InClick + Spacing = 0 + TabOrder = 5 + end + object StaticText2: TStaticText + AnchorSideLeft.Control = Factor1 + AnchorSideBottom.Control = Factor1 + Left = 257 + Height = 16 + Top = 308 + Width = 87 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Bottom = 2 + Caption = 'Factor 1 Variable' + TabOrder = 7 + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = Fact1In + AnchorSideTop.Control = Fact2Out + AnchorSideTop.Side = asrBottom + Left = 221 + Height = 93 + Top = 457 + Width = 187 + AutoSize = True + BorderSpacing.Top = 16 + Caption = 'Options' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 73 + ClientWidth = 183 + TabOrder = 13 + object PlotMeans: TCheckBox + Left = 12 + Height = 19 + Top = 6 + Width = 159 + Caption = 'Plot Means Using 3D bars' + TabOrder = 0 + end + object Plot2DLines: TCheckBox + Left = 12 + Height = 19 + Top = 27 + Width = 159 + Caption = 'Plot Means Using 2D Lines' + TabOrder = 1 + end + object Plot3DLines: TCheckBox + Left = 12 + Height = 19 + Top = 48 + Width = 159 + Caption = 'Plot Means Using 3D Lines' + TabOrder = 2 + end + end + object Label3: TLabel + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = OverallAlpha + AnchorSideTop.Side = asrCenter + Left = 229 + Height = 15 + Top = 562 + Width = 147 + BorderSpacing.Left = 8 + Caption = 'Alpha Level for Overall Tests' + ParentColor = False + end + object HelpBtn: TButton + Tag = 107 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 107 + Height = 25 + Top = 598 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 15 + end + object Factor1: TEdit + AnchorSideLeft.Control = Fact1In + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Fact1Out + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Fact1Out + AnchorSideBottom.Side = asrBottom + Left = 257 + Height = 23 + Top = 326 + Width = 206 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 8 + Text = 'Edit1' + end + object DepOut: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = DepIn + AnchorSideTop.Side = asrBottom + Left = 221 + Height = 28 + Top = 253 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = DepOutClick + Spacing = 0 + TabOrder = 2 + end + object Fact1Out: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Fact1In + AnchorSideTop.Side = asrBottom + Left = 221 + Height = 28 + Top = 333 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Fact1OutClick + Spacing = 0 + TabOrder = 6 + end + object Fact2In: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Fact1Out + AnchorSideTop.Side = asrBottom + Left = 221 + Height = 28 + Top = 381 + Width = 28 + BorderSpacing.Top = 20 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Fact2InClick + Spacing = 0 + TabOrder = 9 + end + object Fact2Out: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Fact2In + AnchorSideTop.Side = asrBottom + Left = 221 + Height = 28 + Top = 413 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Fact2OutClick + Spacing = 0 + TabOrder = 10 + end + object StaticText3: TStaticText + AnchorSideLeft.Control = Factor2 + AnchorSideBottom.Control = Factor2 + Left = 257 + Height = 16 + Top = 388 + Width = 87 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Bottom = 2 + Caption = 'Factor 2 Variable' + TabOrder = 11 + end + object Factor2: TEdit + AnchorSideLeft.Control = Fact2In + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Fact2Out + AnchorSideBottom.Side = asrBottom + Left = 257 + Height = 23 + Top = 406 + Width = 206 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 12 + Text = 'Edit1' + end + object OverallAlpha: TEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox2 + AnchorSideTop.Side = asrBottom + Left = 384 + Height = 23 + Top = 558 + Width = 45 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 14 + Text = 'OverallAlpha' + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 170 + Height = 25 + Top = 598 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 16 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 236 + Height = 25 + Top = 598 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 17 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 310 + Height = 25 + Top = 598 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 18 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 398 + Height = 25 + Top = 598 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 19 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 582 + Width = 471 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 180 + Top = 8 + Width = 455 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Notes: This is a non-parametric analysis of ordinal data. It is similar to a two-way Analysis of Variance but utilizes a chi-square statistic (H) for determining the significance of the row, column and interaction effects. The dependent value, if not initially rank data, may be obtained first by creating a new variable with the "transformation" procedure available under the "Variables" menu. The output of this procedure contains the results both of a "traditional" 2-way ANOVA as well as the SRH results. It should be noted that the power of the SRH analysis is less than that of the traditional ANOVA. It is suggested that there be at least 5 or more cases in each cell and that the design is a balanced design of fixed levels. The H statistic is obtained as the division of the sum of squares for an effect by the mean square of the total and the test is performed by a chi-squared probability with the degrees of freedom equal to the SS of the effect being tested.' + ParentColor = False + WordWrap = True + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/srhtestunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/srhtestunit.pas new file mode 100644 index 000000000..097f56cc9 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/srhtestunit.pas @@ -0,0 +1,733 @@ +unit SRHTestUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, FunctionsLib, OutputUnit, DataProcs, GraphLib, + ContextHelpUnit; + +type + + { TSRHTest } + + TSRHTest = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + ComputeBtn: TButton; + DepIn: TBitBtn; + DepOut: TBitBtn; + DepVar: TEdit; + Fact1In: TBitBtn; + Fact1Out: TBitBtn; + Fact2In: TBitBtn; + Fact2Out: TBitBtn; + Factor1: TEdit; + Factor2: TEdit; + GroupBox2: TGroupBox; + HelpBtn: TButton; + Label1: TLabel; + Label3: TLabel; + Memo1: TLabel; + OverallAlpha: TEdit; + Plot2DLines: TCheckBox; + Plot3DLines: TCheckBox; + PlotMeans: TCheckBox; + ResetBtn: TButton; + ReturnBtn: TButton; + StaticText1: TStaticText; + StaticText2: TStaticText; + StaticText3: TStaticText; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure DepInClick(Sender: TObject); + procedure DepOutClick(Sender: TObject); + procedure Fact1InClick(Sender: TObject); + procedure Fact1OutClick(Sender: TObject); + procedure Fact2InClick(Sender: TObject); + procedure Fact2OutClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: boolean; + NoSelected, intvalue, N : integer; + ColNoSelected : IntDyneVec; + outline, cellstring : string; + SSDep, SSErr, SSF1, SSF2, SSF1F2 : double; + MSDep, MSErr, MSF1, MSF2, MSF1F2 : double; + DFTot, DFErr, DFF1, DFF2, DFF1F2 : double; + Omega, OmegaF1, OmegaF2, OmegaF1F2: double; + FF1, FF2, FF1F2, ProbF1, ProbF2, ProbF1F2 : double; + DepVarCol, F1Col, F2Col, Nf1cells, Nf2cells : integer; + MeanDep, MeanF1, MeanF2, X : double; + minf1, maxf1, minf2, maxf2, nofactors, totcells : integer; + cellcnts : DblDyneVec; // array of cell counts + cellvars : DblDyneVec; // arrray of cell sums of squares then variances + cellsums : DblDyneVec; // array of cell sums then means + equal_grp : boolean; // check for equal groups for post-hoc tests + counts : DblDyneMat; // matrix for 2-way containing cell sizes + sums : DblDyneMat; // matrix for 2-way containing cell sums + vars : DblDyneMat; // matrix for 2-way containing sums of squares + RowSums : DblDyneVec; // 2 way row sums + ColSums : DblDyneVec; // 2 way col sums + RowCount : DblDyneVec; // 2 way row count + ColCount : DblDyneVec; // 2 way col count + NoGrpsA, NoGrpsB : integer; + OrdMeansA, OrdMeansB : DblDyneVec; // reordered means for f1, f2 + allAlpha : double; // alphas for tests + CompError : boolean; + + procedure getlevels(Sender : TObject); + procedure Calc2Way(Sender: TObject); + procedure TwoWayTable(Sender: TObject); + procedure TwoWayPlot(Sender: TObject); + + public + { public declarations } + end; + +var + SRHTest: TSRHTest; + +implementation + +uses + Math; + +{ TSRHTest } + +procedure TSRHTest.ResetBtnClick(Sender: TObject); +Var i : integer; +begin + VarList.Clear; + DepIn.Enabled := true; + Fact1In.Enabled := true; + Fact2In.Enabled := true; + DepOut.Enabled := false; + Fact1Out.Enabled := false; + Fact2Out.Enabled := false; + DepVar.Text := ''; + Factor1.Text := ''; + Factor2.Text := ''; + PlotMeans.Checked := false; + OverAllalpha.Text := '0.05'; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TSRHTest.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TSRHTest.DepInClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + DepVar.Text := VarList.Items.Strings[index]; + DepIn.Enabled := false; + DepOut.Enabled := true; + VarList.Items.Delete(index); +end; + +procedure TSRHTest.ComputeBtnClick(Sender: TObject); +Var + i : integer; +Label cleanit; +label nexttwo; +begin + OutputFrm.RichEdit.Clear; + // initialize values + SetLength(ColNoSelected,NoVariables); + DepVarCol := 0; + F1Col := 0; + F2Col := 0; + SSDep := 0.0; + SSF1 := 0.0; + SSF2 := 0.0; + SSF1F2 := 0.0; + MeanDep := 0.0; + MeanF1 := 0.0; + MeanF2 := 0.0; + Nf1cells := 0; + Nf2cells := 0; + N := 0; + NoSelected := 0; + minf1 := 0; + maxf1 := 0; + minf2 := 0; + maxf2 := 0; + + // Get column numbers of dependent variable and factors + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = DepVar.Text then + begin + DepVarCol := i; + NoSelected := NoSelected + 1; + ColNoSelected[NoSelected-1] := DepVarCol; + end; + if cellstring = Factor1.Text then + begin + F1Col := i; + NoSelected := NoSelected + 1; + ColNoSelected[NoSelected-1] := F1Col; + end; + if cellstring = Factor2.Text then + begin + F2Col := i; + NoSelected := NoSelected + 1; + ColNoSelected[NoSelected-1] := F2Col; + end; + end; + nofactors := 2; + allAlpha := StrToFloat(OverAllalpha.Text); + + // get min and max of each factor code + getlevels(self); + + // allocate space + SetLength(cellcnts,totcells); // array of cell counts + SetLength(cellvars,totcells); // arrray of cell sums of squares then variances + SetLength(cellsums,totcells); // array of cell sums then means + + // initialize array values + for i := 1 to totcells do + begin + cellsums[i-1] := 0.0; + cellvars[i-1] := 0.0; + cellcnts[i-1] := 0; + end; + + // do analysis + SetLength(counts,Nf1cells,Nf2cells); // matrix for 2-way containing cell sizes + SetLength(sums,Nf1cells,Nf2cells); // matrix for 2-way containing cell sums + SetLength(vars,Nf1cells,Nf2cells); // matrix for 2-way containing sums of squares + SetLength(RowSums,Nf1cells); // 2 way row sums + SetLength(ColSums,Nf2cells); // 2 way col sums + SetLength(RowCount,Nf1cells); // 2 way row count + SetLength(ColCount,Nf2cells); // 2 way col count + SetLength(OrdMeansA,Nf1cells); // ordered means for factor 1 + SetLength(OrdMeansB,Nf2cells); // ordered means for factor 2 + + Calc2Way(self); + if CompError then goto nexttwo; + TwoWayTable(self); + OutputFrm.ShowModal; + if (PlotMeans.Checked) or (Plot2DLines.Checked) + or (Plot3DLines.Checked) then TwoWayPlot(self); +nexttwo: OrdMeansB := nil; + OrdMeansA := nil; + ColCount := nil; + RowCount := nil; + ColSums := nil; + RowSums := nil; + vars := nil; + sums := nil; + counts := nil; + +cleanit: + cellcnts := nil; + cellvars := nil; + cellsums := nil; + ColNoSelected := nil; +end; + +procedure TSRHTest.DepOutClick(Sender: TObject); +begin + VarList.Items.Add(DepVar.Text); + DepVar.Text := ''; + DepOut.Enabled := false; + DepIn.Enabled := true; +end; + +procedure TSRHTest.Fact1InClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + if index = -1 then exit; + Factor1.Text := VarList.Items.Strings[index]; + Fact1In.Enabled := false; + Fact1Out.Enabled := true; + VarList.Items.Delete(index); +end; + +procedure TSRHTest.Fact1OutClick(Sender: TObject); +begin + VarList.Items.Add(Factor1.Text); + Factor1.Text := ''; + Fact1Out.Enabled := false; + Fact1In.Enabled := true; +end; + +procedure TSRHTest.Fact2InClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + if index = -1 then exit; + Factor2.Text := VarList.Items.Strings[index]; + Fact2In.Enabled := false; + Fact2Out.Enabled := true; + VarList.Items.Delete(index); +end; + +procedure TSRHTest.Fact2OutClick(Sender: TObject); +begin + VarList.Items.Add(Factor2.Text); + Factor2.Text := ''; + Fact2Out.Enabled := false; + Fact2In.Enabled := true; +end; + +procedure TSRHTest.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinHeight := OverallAlpha.Top + OverallAlpha.Height - VarList.Top; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := True; +end; + +procedure TSRHTest.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +procedure TSRHTest.getlevels(Sender: TObject); +VAR i : integer; +begin + minf1 := 10000; + maxf1 := -10000; + for i := 1 to NoCases do + begin + if Not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]))); + if intvalue > maxf1 then maxf1 := intvalue; + if intvalue < minf1 then minf1 := intvalue; + end; + Nf1cells := maxf1 - minf1 + 1; + if nofactors > 1 then + begin + minf2 := 10000; + maxf2 := -10000; + for i := 1 to NoCases do + begin + if Not GoodRecord(i,NoSelected,ColNoSelected) then continue; + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F2Col,i]))); + if intvalue > maxf2 then maxf2 := intvalue; + if intvalue < minf2 then minf2 := intvalue; + end; + Nf2cells := maxf2 - minf2 + 1; + end; + totcells := Nf1cells + Nf2cells; +end; + +procedure TSRHTest.Calc2Way(Sender: TObject); +var + i, j : integer; + grpA, grpB : integer; + Constant, RowsTotCnt, ColsTotCnt, SSCells : double; +begin + CompError := false; + // initialize matrix values + NoGrpsA := maxf1 - minf1 + 1; + NoGrpsB := maxf2 - minf2 + 1; + for i := 1 to NoGrpsA do + begin + RowSums[i-1] := 0.0; + RowCount[i-1] := 0.0; + for j := 1 to NoGrpsB do + begin + counts[i-1,j-1] := 0.0; + sums[i-1,j-1] := 0.0; + vars[i-1,j-1] := 0.0; + end; + end; + for i := 1 to NoGrpsB do + begin + ColCount[i-1] := 0.0; + ColSums[i-1] := 0.0; + end; + N := 0; + MeanDep := 0.0; + SSDep := 0.0; + SSCells := 0.0; + RowsTotCnt := 0.0; + ColsTotCnt := 0.0; + // get working totals + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + grpA := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]))); + grpB := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F2Col,i]))); + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepVarCol,i])); + grpA := grpA - minf1 + 1; + grpB := grpB - minf2 + 1; + counts[grpA-1,grpB-1] := counts[grpA-1,grpB-1] + 1; + sums[grpA-1,grpB-1] := sums[grpA-1,grpB-1] + X; + vars[grpA-1,grpB-1] := vars[grpA-1,grpB-1] + (X * X); + RowSums[GrpA-1] := RowSums[GrpA-1] + X; + ColSums[GrpB-1] := ColSums[GrpB-1] + X; + RowCount[GrpA-1] := RowCount[GrpA-1] + 1.0; + ColCount[GrpB-1] := ColCount[GrpB-1] + 1.0; + MeanDep := MeanDep + X; + SSDep := SSDep + (X * X); + N := N + 1; + end; + + // Calculate results + for i := 0 to NoGrpsA-1 do + begin + SSF1 := SSF1 + ((RowSums[i] * RowSums[i]) / RowCount[i]); + RowsTotCnt := RowsTotCnt + RowCount[i]; + end; + for j := 0 to NoGrpsB-1 do + begin + SSF2 := SSF2 + ((ColSums[j] * ColSums[j]) / ColCount[j]); + ColsTotCnt := ColsTotCnt + ColCount[j]; + end; + for i := 0 to NoGrpsA-1 do + begin + for j := 0 to NoGrpsB-1 do + if counts[i,j] > 0 then + SSCells := SSCells + ((sums[i,j] * sums[i,j]) / counts[i,j]); + end; + if N > 0 then Constant := (MeanDep * MeanDep) / N else Constant := 0.0; + SSF1 := SSF1 - Constant; + SSF2 := SSF2 - Constant; + SSF1F2 := SSCells - SSF1 - SSF2 - Constant; + SSErr := SSDep - SSCells; + SSDep := SSDep - Constant; + + + if (SSF1F2 < 0) or (SSF1 < 0) or (SSF2 < 0) then + begin + ShowMessage('ERROR! A negative SS found. Unbalanced design? Ending analysis.'); + CompError := true; + exit; + end; + DFTot := N - 1; + DFF1 := NoGrpsA - 1; + DFF2 := NoGrpsB - 1; + DFF1F2 := DFF1 * DFF2; + DFErr := DFTot - DFF1 - DFF2 - DFF1F2; +// DFCells := N - (NoGrpsA * NoGrpsB); + MSF1 := SSF1 / DFF1; + MSF2 := SSF2 / DFF2; + MSF1F2 := SSF1F2 / DFF1F2; + MSErr := SSErr / DFErr; + MSDep := SSDep / DFTot; + OmegaF1 := (SSF1 - DFF1 * MSErr) / (SSDep + MSErr); + OmegaF2 := (SSF2 - DFF2 * MSErr) / (SSDep + MSErr); + OmegaF1F2 := (SSF1F2 - DFF1F2 * MSErr) / (SSDep + MSErr); + Omega := OmegaF1 + OmegaF2 + OmegaF1F2; + MeanDep := MeanDep / N; + // f tests for fixed effects + FF1 := abs(MSF1 / MSErr); + FF2 := abs(MSF2 / MSErr); + FF1F2 := abs(MSF1F2 / MSErr); + ProbF1 := probf(FF1,DFF1,DFErr); + ProbF2 := probf(FF2,DFF2,DFErr); + ProbF1F2 := probf(FF1F2,DFF1F2,DFErr); + if (ProbF1 > 1.0) then ProbF1 := 1.0; + if (ProbF2 > 1.0) then ProbF2 := 1.0; + if (ProbF1F2 > 1.0) then ProbF1F2 := 1.0; + + // Obtain omega squared (proportion of dependent variable explained) + if (OmegaF1 < 0.0) then OmegaF1 := 0.0; + if (OmegaF2 < 0.0) then OmegaF2 := 0.0; + if (OmegaF1F2 < 0.0) then OmegaF1F2 := 0.0; + if (Omega < 0.0) then Omega := 0.0; +end; + +procedure TSRHTest.TwoWayTable(Sender: TObject); +var + groupsize : integer; + MinVar, MaxVar, sumvars, sumDFrecip : double; + i, j : integer; + XBar, V, S, RowSS, ColSS : double; + sumfreqlogvar, c, bartlett, cochran, hartley, chiprob : double; + H, HProb : double; +begin + If CompError then exit; + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Two Way Analysis of Variance'); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Variable analyzed: %s',[DepVar.Text]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Factor A (rows) variable: %s',[Factor1.Text]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Factor B (columns) variable: %s',[Factor2.Text]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('SOURCE D.F. SS MS F PROB.> F Omega Sqr. H H Prob.'); + OutputFrm.RichEdit.Lines.Add(''); + H := SSF1 / MSDep; + HProb := 1.0 - chisquaredprob(H,round(DFF1)); + outline := format('Among Rows %4.0f %8.3f %8.3f %8.3f %6.3f %6.3f %6.3f %6.3f', + [DFF1,SSF1,MSF1,FF1,ProbF1,OmegaF1, H, HProb]); + OutputFrm.RichEdit.Lines.Add(outline); + H := SSF2 / MSDep; + HProb := 1.0 - chisquaredprob(H,round(DFF2)); + outline := format('Among Columns %4.0f %8.3f %8.3f %8.3f %6.3f %6.3f %6.3f %6.3f', + [DFF2,SSF2,MSF2,FF2,ProbF2,OmegaF2,H , HProb]); + OutputFrm.RichEdit.Lines.Add(outline); + H := SSF1F2 / MSDep; + HProb := 1.0 - chisquaredprob(H,round(DFF1F2)); + outline := format('Interaction %4.0f %8.3f %8.3f %8.3f %6.3f %6.3f %6.3f %6.3f', + [DFF1F2,SSF1F2,MSF1F2,FF1F2,ProbF1F2,OmegaF1F2, H, HProb]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Within Groups %4.0f %8.3f %8.3f', + [DFErr,SSErr,MSErr]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Total %4.0f %8.3f %8.3f', + [DFTot,SSDep,MSDep]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Omega squared for combined effects = %8.3f',[Omega]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Descriptive Statistics'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('GROUP Row Col. N MEAN VARIANCE STD.DEV.'); + groupsize := round(counts[0,0]); + equal_grp := true; + MaxVar := 0.0; + MinVar := 1e20; + sumvars := 0.0; + sumfreqlogvar := 0.0; + sumDFrecip := 0.0; + + // Display cell means, variances, standard deviations + V := 0.0; + XBar := 0.0; + S := 0.0; + for i := 0 to NoGrpsA-1 do + begin + for j := 0 to NoGrpsB-1 do + begin + if counts[i,j] > 1 then + begin + XBar := sums[i,j] / counts[i,j]; + V := vars[i,j] - ( (sums[i,j] * sums[i,j]) / counts[i,j]); + V := V / (counts[i,j] - 1.0); + S := sqrt(V); + sumvars := sumvars + V; + if V > MaxVar then MaxVar := V; + if V < MinVar then MinVar := V; + sumDFrecip := sumDFrecip + (1.0 / (counts[i,j] - 1.0)); + sumfreqlogvar := sumfreqlogvar + ((counts[i,j] - 1.0) * ln(V)); + if counts[i,j] <> groupsize then equal_grp := false; + end; + outline := format('Cell %3d %3d %3.0f %8.3f %8.3f %8.3f', + [minf1+i,minf2+j,counts[i,j],XBar,V,S]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + end; + + //Display Row means, variances, standard deviations + for i := 0 to NoGrpsA-1 do + begin + XBar := RowSums[i] / RowCount[i]; + OrdMeansA[i] := XBar; + RowSS := 0.0; + for j := 0 to NoGrpsB-1 do RowSS := RowSS + vars[i,j]; + V := RowSS - (RowSums[i] * RowSums[i] / RowCount[i]); + V := V / (RowCount[i] - 1.0); + S := sqrt(V); + outline := format('Row %3d %3.0f %8.3f %8.3f %8.3f', + [minf1+i,RowCount[i],XBar,V,S]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + + //Display means, variances and standard deviations for columns + for j := 0 to NoGrpsB-1 do + begin + XBar := ColSums[j] / ColCount[j]; + OrdMeansB[j] := XBar; + ColSS := 0.0; + for i := 0 to NoGrpsA-1 do ColSS := ColSS + vars[i,j]; + if ColCount[j] > 0 then V := ColSS - (ColSums[j] * ColSums[j] / ColCount[j]); + if ColCount[j] > 1 then V := V / (ColCount[j] - 1.0); + if V > 0.0 then S := sqrt(V); + outline := format('Col %3d %3.0f %8.3f %8.3f %8.3f', + [minf2+j,ColCount[j],XBar,V,S]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + + outline := format('TOTAL %3d %8.3f %8.3f %8.3f', + [N,MeanDep,MSDep,sqrt(MSDep)]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add(''); + c := 1.0 + (1.0 / (3.0 * NoGrpsA * NoGrpsB - 1.0)) * (sumDFrecip - (1.0 / DFErr)); + bartlett := (2.303 / c) * ((DFErr * ln(MSErr)) - sumfreqlogvar); + chiprob := 1.0 - chisquaredprob(bartlett,round(NoGrpsA * NoGrpsB - 1)); + cochran := maxvar / sumvars; + hartley := maxvar / minvar; + OutputFrm.RichEdit.Lines.Add('TESTS FOR HOMOGENEITY OF VARIANCE'); + OutputFrm.RichEdit.Lines.Add('---------------------------------------------------------------------'); + outline := format('Hartley Fmax test statistic = %10.2f with deg.s freedom: %d and %d.', + [hartley, (NoGrpsA*NoGrpsB),(groupsize-1) ]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Cochran C statistic = %10.2f with deg.s freedom: %d and %d.', + [cochran, (NoGrpsA*NoGrpsB), (groupsize - 1)]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Bartlett Chi-square statistic = %10.2f with %4d D.F. Prob. larger value = %6.3f', + [bartlett, (NoGrpsA*NoGrpsB - 1), chiprob]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add('---------------------------------------------------------------------'); +end; + +procedure TSRHTest.TwoWayPlot(Sender: TObject); +var + i, j : integer; + maxmean, XBar : double; + XValue : DblDyneVec; + title : string; + plottype : integer; + setstring : string[11]; +begin + if CompError then exit; + SetLength(XValue,Nf1cells+Nf2cells); + plottype := 2; + if PlotMeans.Checked then plottype := 2; + if Plot2DLines.Checked then plottype := 5; + if Plot3DLines.Checked then plottype := 6; + + // do Factor A first + setstring := 'FACTOR A'; + GraphFrm.SetLabels[1] := setstring; + maxmean := 0.0; + SetLength(GraphFrm.Xpoints,1,NF1cells); + SetLength(GraphFrm.Ypoints,1,NF1cells); + for i := 1 to NF1cells do + begin + RowSums[i-1] := RowSums[i-1] / RowCount[i-1]; + GraphFrm.Ypoints[0,i-1] := RowSums[i-1]; + if RowSums[i-1] > maxmean then maxmean := RowSums[i-1]; + XValue[i-1] := minF1 + i - 1; + GraphFrm.Xpoints[0,i-1] := XValue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NF1cells; + GraphFrm.Heading := Factor1.Text; + title := Factor1.Text + ' Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + // do Factor B next + setstring := 'FACTOR B'; + GraphFrm.SetLabels[1] := setstring; + maxmean := 0.0; + SetLength(GraphFrm.Xpoints,1,NF2cells); + SetLength(GraphFrm.Ypoints,1,NF2cells); + for i := 1 to NF2cells do + begin + ColSums[i-1] := ColSums[i-1] / ColCount[i-1]; + GraphFrm.Ypoints[0,i-1] := ColSums[i-1]; + if ColSums[i-1] > maxmean then maxmean := ColSums[i-1]; + XValue[i-1] := minF1 + i - 1; + GraphFrm.Xpoints[0,i-1] := XValue[i-1]; + end; + GraphFrm.nosets := 1; + GraphFrm.nbars := NF2cells; + GraphFrm.Heading := Factor2.Text; + title := Factor2.Text + ' Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + + // do Factor A x B Interaction next + maxmean := 0.0; + SetLength(GraphFrm.Ypoints,NF1cells,NF2cells); + SetLength(GraphFrm.Xpoints,1,NF2cells); + for i := 1 to NF1cells do + begin + setstring := Factor1.Text + ' ' + IntToStr(i); + GraphFrm.SetLabels[i] := setstring; + for j := 1 to NF2cells do + begin + XBar := sums[i-1,j-1] / counts[i-1,j-1]; + if XBar > maxmean then maxmean := XBar; + GraphFrm.Ypoints[i-1,j-1] := XBar; + end; + end; + for j := 1 to NF2cells do + begin + XValue[j-1] := minF2 + j - 1; + GraphFrm.Xpoints[0,j-1] := XValue[j-1]; + end; + + GraphFrm.nosets := NF1cells; + GraphFrm.nbars := NF2cells; + GraphFrm.Heading := 'Factor A x Factor B'; + title := Factor2.Text + ' Codes'; + GraphFrm.XTitle := title; + GraphFrm.YTitle := 'Mean'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScaled := false; + GraphFrm.miny := 0.0; + GraphFrm.maxy := maxmean; + GraphFrm.GraphType := plottype; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + XValue := nil; + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +initialization + {$I srhtestunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/nonparametric/wilcoxonunit.lfm b/applications/lazstats/source/forms/analysis/nonparametric/wilcoxonunit.lfm new file mode 100644 index 000000000..e8170db42 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/wilcoxonunit.lfm @@ -0,0 +1,265 @@ +object WilcoxonFrm: TWilcoxonFrm + Left = 498 + Height = 352 + Top = 336 + Width = 436 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Wilcoxon Matched Pairs Signed Ranks Test' + ClientHeight = 352 + ClientWidth = 436 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables Available' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Var1Edit + AnchorSideBottom.Control = Var1Edit + Left = 240 + Height = 15 + Top = 33 + Width = 50 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Variable 1' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Var2Edit + AnchorSideBottom.Control = Var2Edit + Left = 240 + Height = 15 + Top = 125 + Width = 50 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Variable 2' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Var1In + AnchorSideBottom.Control = Bevel1 + Left = 9 + Height = 278 + Top = 25 + Width = 187 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 9 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + OnSelectionChange = VarListSelectionChange + TabOrder = 0 + end + object Var1In: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 204 + Height = 28 + Top = 25 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Var1InClick + Spacing = 0 + TabOrder = 1 + end + object Var1Out: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Var1In + AnchorSideTop.Side = asrBottom + Left = 204 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Var1OutClick + Spacing = 0 + TabOrder = 2 + end + object Var2In: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Var1Out + AnchorSideTop.Side = asrBottom + Left = 204 + Height = 28 + Top = 117 + Width = 28 + BorderSpacing.Top = 32 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = Var2InClick + Spacing = 0 + TabOrder = 4 + end + object Var2Out: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Var2In + AnchorSideTop.Side = asrBottom + Left = 204 + Height = 28 + Top = 149 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = Var2OutClick + Spacing = 0 + TabOrder = 5 + end + object Var1Edit: TEdit + AnchorSideLeft.Control = Var1In + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Var1Out + AnchorSideBottom.Side = asrBottom + Left = 240 + Height = 23 + Top = 50 + Width = 188 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 3 + Text = 'Var1Edit' + end + object Var2Edit: TEdit + AnchorSideLeft.Control = Var2In + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Var2Out + AnchorSideBottom.Side = asrBottom + Left = 240 + Height = 23 + Top = 142 + Width = 188 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + ReadOnly = True + TabOrder = 6 + Text = 'Var2Edit' + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 227 + Height = 25 + Top = 319 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 8 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 289 + Height = 25 + Top = 319 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 9 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 373 + Height = 25 + Top = 319 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 10 + end + object HelpBtn: TButton + Tag = 156 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 168 + Height = 25 + Top = 319 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 7 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 303 + Width = 436 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Bevel2: TBevel + Left = 3 + Height = 20 + Top = 336 + Width = 16 + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/nonparametric/wilcoxonunit.pas b/applications/lazstats/source/forms/analysis/nonparametric/wilcoxonunit.pas new file mode 100644 index 000000000..ee9b3a6eb --- /dev/null +++ b/applications/lazstats/source/forms/analysis/nonparametric/wilcoxonunit.pas @@ -0,0 +1,372 @@ +unit WilcoxonUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, OutputUnit, FunctionsLib, Globals, DataProcs, ContextHelpUnit; + +type + + { TWilcoxonFrm } + + TWilcoxonFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + HelpBtn: TButton; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + Var1Edit: TEdit; + Var2Edit: TEdit; + Label2: TLabel; + Label3: TLabel; + Var1In: TBitBtn; + Var1Out: TBitBtn; + Var2In: TBitBtn; + Var2Out: TBitBtn; + Label1: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure Var1InClick(Sender: TObject); + procedure Var1OutClick(Sender: TObject); + procedure Var2InClick(Sender: TObject); + procedure Var2OutClick(Sender: TObject); + procedure VarListSelectionChange(Sender: TObject; User: boolean); + private + { private declarations } + FAutoSized: Boolean; + procedure UpdateBtnStates; + public + { public declarations } + end; + +var + WilcoxonFrm: TWilcoxonFrm; + +implementation + +uses + Math; + +{ TWilcoxonFrm } + +procedure TWilcoxonFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + Var1Edit.Text := ''; + Var2Edit.Text := ''; + VarList.Items.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + UpdateBtnStates; +end; + +procedure TWilcoxonFrm.Var1InClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (Var1Edit.Text = '') then + begin + Var1Edit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TWilcoxonFrm.Var1OutClick(Sender: TObject); +begin + if Var1Edit.Text <> '' then + begin + VarList.Items.Add(Var1Edit.Text); + Var1Edit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TWilcoxonFrm.Var2InClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (Var2Edit.Text = '') then + begin + Var2Edit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TWilcoxonFrm.Var2OutClick(Sender: TObject); +begin + if Var2Edit.Text <> '' then + begin + VarList.Items.Add(Var2Edit.Text); + Var2Edit.Text := ''; + end; + UpdateBtnStates; +end; + +procedure TWilcoxonFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + +procedure TWilcoxonFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TWilcoxonFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TWilcoxonFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TWilcoxonFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TWilcoxonFrm.ComputeBtnClick(Sender: TObject); +var + zprob, numerator, denominator, z, negsum : double; + possum, t, sum, Avg : double; + A, b, d, r : DblDyneVec; + M, N, i, j, itemp, col1, col2, NoSelected: integer; + index : IntdyneVec; + ColNoSelected : IntDyneVec; + labelone, labeltwo, cellstring: string; + lReport: TStrings; + negcnt: Integer = 0; + poscnt: Integer = 0; +begin + if Var1Edit.Text = '' then + begin + MessageDlg('Variable 1 not selected.', mtError, [mbOK], 0); + exit; + end; + + if Var2Edit.Text = '' then + begin + MessageDlg('Variable 2 not selected.', mtError, [mbOK], 0); + exit; + end; + + negsum := 0.0; + possum := 0.0; + NoSelected := 2; + + // Allocate memory + SetLength(ColNoSelected,NoVariables); + SetLength(A,NoCases); + SetLength(b,NoCases); + SetLength(d,NoCases); + SetLength(index,NoCases); + SetLength(r,NoCases); + + // Get column numbers and labels of variables selected + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = Var1Edit.Text then + begin + ColNoSelected[0] := i; + labelone := cellstring; + end; + if cellstring = Var2Edit.Text then + begin + ColNoSelected[1] := i; + labeltwo := cellstring; + end; + end; + + // Get scores and differences + N := 0; + for i := 1 to NoCases do + begin + if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; + N := N + 1; + index[i-1] := N; + col1 := ColNoSelected[0]; + col2 := ColNoSelected[1]; + A[N-1] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col1,i])); + b[N-1] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col2,i])); + d[N-1] := A[N-1] - b[N-1]; + end; + + // Rank on absolute score differences + for i := 1 to N - 1 do + begin + for j := i + 1 to N do + begin + if (abs(d[i-1]) > abs(d[j-1])) then + begin + t := d[i-1]; + d[i-1] := d[j-1]; + d[j-1] := t; + t := A[i-1]; + A[i-1] := A[j-1]; + A[j-1] := t; + t := b[i-1]; + b[i-1] := b[j-1]; + b[j-1] := t; + itemp := index[i-1]; + index[i-1] := index[j-1]; + index[j-1] := itemp; + end; + end; + end; + + // Eliminate cases with 0 score differences + i := 1; + while (i <= N) do + begin + if (d[i-1] = 0.0) then // found a 0 score difference - move all up one + begin + if i < N then + begin + for j := i + 1 to N do + begin + d[j] := d[j-1]; + A[j] := A[j-1]; + b[j] := b[j-1]; + index[j] := index[j-1]; + end; + N := N - 1; + i := 1; + end + else begin + N := N - 1; + i := 1; + end; + end + else i := i + 1; + end; + + // Assign ranks + for i := 1 to N do r[i-1] := i; + + // Find matching differences and assign common rank + i := 1; + while (i < N) do + begin + M := 0; + sum := 0; + for j := i + 1 to N do + begin + if ( abs(d[j-1]) = abs(d[i-1]) ) then + begin + M := M + 1; + sum := sum + r[j-1]; + end; + end; + if (M > 0) then //matched differences found - assign average rank + begin + sum := sum + r[i-1]; // add the ith value too + Avg := sum / (M + 1); // count the ith value too + for j := i to (i + M) do r[j-1] := Avg; + i := i + M + 1; + end + else i := i + 1; + end; + + // Assign sign of difference to ranks + for i := 1 to N do if (d[i-1] < 0.0) then r[i-1] := -r[i-1]; + + // Get sum of negative and positive difference ranks + for i := 1 to N do + begin + if (d[i-1] < 0.0) then + begin + negsum := negsum + abs(r[i-1]); + negcnt := negcnt + 1; + end + else + begin + possum := possum + abs(r[i-1]); + poscnt := poscnt + 1; + end; + end; + if (negsum < possum) then t := negsum + else t := possum; + numerator := t - ((N * (N + 1)) / 4.0); + denominator := sqrt((N * (N + 1) * (2 * N + 1)) / 24.0); + z := abs(numerator / denominator); + zprob := 1.0 - probz(z); + + // Now, display results + lReport := TStringList.Create; + try + lReport.Add('WILCONXON MATCHED-PAIRS SIGNED-RANKS TEST'); + lReport.Add('See pages 75-83 in S. Seigel: Nonparametric Statistics for the Social Sciences'); + lReport.Add(''); + lReport.Add('Ordered Cases with cases having 0 differences eliminated:'); + lReport.Add('Number of cases with absolute differences greater than 0: %d', [N]); + lReport.Add('CASE %10s %10s Difference Signed Rank', [labelone, labeltwo]); + for i := 1 to N do + lReport.Add('%3d %6.2f %6.2f %6.2f %6.2f', [index[i-1], A[i-1], b[i-1], d[i-1], r[i-1]]); + lReport.Add(''); + lReport.Add('Smaller sum of ranks (T): %8.2f', [t]); + lReport.Add('Approximately normal z for test statistic T: %8.4f', [z]); + lReport.Add('Probability (1-tailed) of greater z: %8.4f', [zprob]); + lReport.Add(''); + lReport.Add('NOTE: For N < 25 use tabled values for Wilcoxon Test'); + + DisplayReport(lReport); + + finally + lReport.Free; + r := nil; + index := nil; + d := nil; + b := nil; + A := nil; + ColNoSelected := nil; + end; +end; + +procedure TWilcoxonFrm.UpdateBtnStates; +begin + Var1In.Enabled := (VarList.ItemIndex > -1) and (Var1Edit.Text = ''); + Var2In.Enabled := (VarList.ItemIndex > -1) and (Var2Edit.Text = ''); + Var1Out.Enabled := (Var1Edit.Text <> ''); + Var2Out.Enabled := (Var2Edit.Text <> ''); +end; + + +initialization + {$I wilcoxonunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/one_sample_tests/onesampunit.lfm b/applications/lazstats/source/forms/analysis/one_sample_tests/onesampunit.lfm new file mode 100644 index 000000000..90f04f45e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/one_sample_tests/onesampunit.lfm @@ -0,0 +1,271 @@ +object OneSampFrm: TOneSampFrm + Left = 490 + Height = 188 + Top = 260 + Width = 430 + AutoSize = True + BorderStyle = bsSingle + Caption = 'One Sample Tests' + ClientHeight = 188 + ClientWidth = 430 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object RadioGroup1: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 131 + Top = 8 + Width = 149 + Anchors = [akTop, akLeft, akBottom] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Statistic of Interest' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 111 + ClientWidth = 145 + ItemIndex = 0 + Items.Strings = ( + 'Sample Mean' + 'Sample Proportion' + 'Sample Correlation' + 'Sample Variance' + ) + OnClick = RadioGroup1Click + TabOrder = 0 + end + object Panel1: TPanel + AnchorSideLeft.Control = RadioGroup1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + Left = 181 + Height = 131 + Top = 8 + Width = 236 + AutoSize = True + BorderSpacing.Left = 24 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 131 + ClientWidth = 236 + TabOrder = 1 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Statistic + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 4 + Width = 99 + Caption = 'Sample Proportion' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Parameter + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 31 + Width = 118 + Caption = 'Population Parameter:' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Size + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 58 + Width = 65 + Caption = 'Sample Size:' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = CInterval + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 112 + Width = 112 + Caption = 'Confidence Level (%)' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = StdDev + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 85 + Width = 145 + Caption = 'Sample Standard Deviation:' + ParentColor = False + end + object Statistic: TEdit + AnchorSideLeft.Control = StdDev + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = StdDev + AnchorSideRight.Side = asrBottom + Left = 153 + Height = 23 + Top = 0 + Width = 83 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + Text = 'Statistic' + end + object StdDev: TEdit + AnchorSideLeft.Control = Label5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Size + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 153 + Height = 23 + Top = 81 + Width = 83 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + TabOrder = 3 + Text = 'Edit1' + end + object Parameter: TEdit + AnchorSideLeft.Control = StdDev + AnchorSideTop.Control = Statistic + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = StdDev + AnchorSideRight.Side = asrBottom + Left = 153 + Height = 23 + Top = 27 + Width = 83 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 1 + Text = 'Edit1' + end + object Size: TEdit + AnchorSideLeft.Control = StdDev + AnchorSideTop.Control = Parameter + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = StdDev + AnchorSideRight.Side = asrBottom + Left = 153 + Height = 23 + Top = 54 + Width = 83 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 2 + Text = 'Edit1' + end + object CInterval: TEdit + AnchorSideLeft.Control = StdDev + AnchorSideTop.Control = StdDev + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = StdDev + AnchorSideRight.Side = asrBottom + Left = 153 + Height = 23 + Top = 108 + Width = 83 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 4 + Text = 'Edit1' + end + end + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Side = asrBottom + Left = 221 + Height = 25 + Top = 155 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 2 + end + object CloseBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 367 + Height = 25 + Top = 155 + Width = 55 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 4 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Side = asrBottom + Left = 283 + Height = 25 + Top = 155 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 3 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 139 + Width = 430 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/one_sample_tests/onesampunit.pas b/applications/lazstats/source/forms/analysis/one_sample_tests/onesampunit.pas new file mode 100644 index 000000000..9ef104b41 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/one_sample_tests/onesampunit.pas @@ -0,0 +1,313 @@ +unit OneSampUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls; + +type + + { TOneSampFrm } + + TOneSampFrm = class(TForm) + Bevel1: TBevel; + ComputeBtn: TButton; + ResetBtn: TButton; + CloseBtn: TButton; + Statistic: TEdit; + Parameter: TEdit; + Size: TEdit; + CInterval: TEdit; + StdDev: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Panel1: TPanel; + RadioGroup1: TRadioGroup; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure RadioGroup1Click(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + public + { public declarations } + end; + +var + OneSampFrm: TOneSampFrm; + +implementation + +uses + Math, + Globals, OutputUnit, FunctionsLib; + +{ TOneSampFrm } + +procedure TOneSampFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; +end; + +procedure TOneSampFrm.FormCreate(Sender: TObject); +begin + CInterval.Text := FormatFloat('0', DEFAULT_CONFIDENCE_LEVEL_PERCENT); +end; + +procedure TOneSampFrm.ResetBtnClick(Sender: TObject); +begin + Statistic.Text := ''; + Parameter.Text := ''; + Size.Text := ''; + StdDev.Text := ''; +end; + +procedure TOneSampFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TOneSampFrm.RadioGroup1Click(Sender: TObject); +begin + Label5.Enabled := RadioGroup1.ItemIndex = 0; + StdDev.Enabled := RadioGroup1.ItemIndex = 0; +{ if RadioGroup1.ItemIndex <> 0 then + begin + Label5.Visible := false; + StdDev.Visible := false; + end + else + begin + Label5.Visible := true; + StdDev.Visible := true; + end; +} +end; + +procedure TOneSampFrm.ComputeBtnClick(Sender: TObject); +var + N : integer; + sampmean, sampprop, sampcor, sampvar, Confidence, alpha, df : double; + popmean, popprop, popcor, popvar, stderr : double; + z, zprobability, zreject, zconf, UCL, LCL, sampsd : double; + t, tprobability, testt : double; + poptrans, samptrans, chisqrval, chiprob, lowchi, hichi, testchi : double; + lReport: TStrings; + msg: String; + C: TWinControl; +begin + if not Validate(msg, C) then + begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + exit; + end; + + lReport := TStringList.Create; + try + N := round(StrToFloat(Size.Text)); + Confidence := StrToFloat(CInterval.Text) / 100.0; + case RadioGroup1.ItemIndex of + 0 : begin + sampmean := StrToFloat(Statistic.Text); + popmean := StrToFloat(Parameter.Text); + sampsd := StrToFloat(StdDev.Text); + df := N; + stderr := sampsd / sqrt(df); + df := N-1; + t := (sampmean - popmean) / stderr; + tprobability := probt(t,df); + alpha := (1.0 - confidence) / 2.0; + testt := inverset((1.0 - alpha),df); + UCL := sampmean + testt * stderr; + LCL := sampmean - testt * stderr; + lReport.Add('ANALYSIS OF A SAMPLE MEAN'); + lReport.Add(''); + lReport.Add('Sample Mean: %9.3f', [sampmean]); + lReport.Add('Population Mean: %9.3f', [popmean]); + lReport.Add('Sample Size: %9d', [N]); + lReport.Add('Standard error of Mean: %9.3f', [stderr]); + lReport.Add('t test statistic: %9.3f', [t]); + lReport.Add(' with probability: %9.3f', [tprobability]); + lReport.Add('t value required for rejection: %9.3f', [testt]); + lReport.Add('Confidence Interval: (%.3f ... %.3f)', [LCL, UCL]); + end; + 1 : begin + sampprop := StrToFloat(Statistic.Text); + popprop := StrToFloat(Parameter.Text); + stderr := sqrt((sampprop * (1.0 - sampprop)) / N); + z := (sampprop - popprop) / StdErr; + zprobability := 1.0 - probz(z); + zreject := inversez(confidence); + zconf := abs(inversez((1.0 - confidence) / 2.0)); + UCL := sampprop + (zconf * stderr); + LCL := sampprop - (zconf * stderr); + lReport.Add('ANALYSIS OF A SAMPLE PROPORTION'); + lReport.Add(''); + lReport.Add('Sample Proportion: %9.3f', [sampprop]); + lReport.Add('Population Proportion: %9.3f', [popprop]); + lReport.Add('Sample Size: %9d', [N]); + lReport.Add('Standard error of proportion: %9.3f', [stderr]); + lReport.Add('z test statistic: %9.3f', [z]); + lReport.Add(' with probability > P: %9.3f', [zprobability]); + lReport.Add('z value required for rejection: %9.3f', [zreject]); + lReport.Add('Confidence Interval: (%.3f ... %.3f)', [LCL, UCL]); + end; + 2 : begin + sampcor := StrToFloat(Statistic.Text); + popcor := StrToFloat(Parameter.Text); + zconf := abs(inversez((1.0 - confidence) / 2.0)); + samptrans := ln((1.0 + sampcor) / (1.0 - sampcor)) / 2.0; + poptrans := ln((1.0 + popcor) / (1.0 - popcor)) / 2.0; + stderr := sqrt(1.0 / (N - 3.0)); + z := (samptrans - poptrans) / stderr; + zprobability := probz(z); + alpha := (1.0 - confidence) / 2.0; + zreject := inversez(1.0 - alpha); + UCL := samptrans + (zconf * stderr); + LCL := samptrans - (zconf * stderr); + UCL := (exp(2.0 * UCL) - 1.0) / (exp(2.0 * UCL) + 1.0); + LCL := (exp(2.0 * LCL) - 1.0) / (exp(2.0 * LCL) + 1.0); + lReport.Add('ANALYSIS OF A SAMPLE CORRELATION'); + lReport.Add(''); + lReport.Add('Sample Correlation: %9.3f', [sampcor]); + lReport.Add('Population Correlation: %9.3f', [popcor]); + lReport.Add('Sample Size: %9d', [N]); + lReport.Add('z Transform of sample correlation: %9.3f', [samptrans]); + lReport.Add('z Transform of population correlation: %9.3f', [poptrans]); + lReport.Add('Standard error of transform: %9.3f', [stderr]); + lReport.Add('z test statistic: %9.3f', [z]); + lReport.Add(' with probability: %9.3f', [zprobability]); + lReport.Add('z value required for rejection: %9.3f', [zreject]); + lReport.Add('Confidence Interval for sample correlation: (%.3f ... %.3f)', [LCL, UCL]); + end; + 3 : begin + sampvar := StrToFloat(Statistic.Text); + popvar := StrToFloat(Parameter.Text); + alpha := 1.0 - confidence; + chisqrval := ((N - 1.0) * sampvar) / Popvar; + chiprob := 1.0 - chisquaredprob(chisqrval,N-1); + lowchi := inversechi((1.0 - alpha / 2.0),N-1); + hichi := inversechi((alpha / 2.0),N-1); + LCL := ((N - 1.0) * sampvar) / lowchi; + UCL := ((N - 1.0) * sampvar) / hichi; + if sampvar > popvar then + testchi := lowchi + else + testchi := hichi; + lReport.Add('ANALYSIS OF A SAMPLE VARIANCE'); + lReport.Add(''); + lReport.Add('Sample Variance: %9.3f', [sampvar]); + lReport.Add('Population Variance: %9.3f', [popvar]); + lReport.Add('Sample Size: %9d', [N]); + lReport.Add('Chi-square statistic %9.3f', [chisqrval]); + lReport.Add(' with probability > chisquare %9.3f', [chiprob]); + lReport.Add(' and D.F. %9d', [N-1]); + lReport.Add('Chi-square value required for rejection: %9.3f', [testchi]); + lReport.Add('Chi-square Confidence Interval: (%.3f ... %.3f)', [lowchi, hichi]); + lReport.Add('Variance Confidence Interval: (%.3f ... %.3f)', [LCL, UCL]); + end; + end; + DisplayReport(lReport); + finally + lReport.Free; + end; +end; + +function TOneSampFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + x: Double; + n: Integer; +begin + Result := false; + + if Statistic.Text = '' then + begin + AMsg := 'Value of sample proportion missing.'; + AControl := Statistic; + exit; + end; + if not TryStrtoFloat(Statistic.Text, x) then + begin + AMsg := 'Sample proportion is not a valid number.'; + AControl := Statistic; + exit; + end; + + if Parameter.Text = '' then + begin + AMsg := 'Value of population parameter is missing.'; + AControl := Parameter; + exit; + end; + if not TryStrToFloat(Parameter.Text, x) then + begin + AMsg := 'Population parameter is not a valid number.'; + AControl := Parameter; + exit; + end; + + if Size.Text = '' then + begin + AMsg := 'Value of sample size is missing.'; + AControl := Size; + exit; + end; + if not TryStrToInt(Size.Text, n) then + begin + AMsg := 'Sample size is not a valid number.'; + AControl := Size; + exit; + end; + + if RadioGroup1.ItemIndex = 0 then + begin + if StdDev.Text = '' then + begin + AMsg := 'Sample standard deviation is not specified.'; + AControl := StdDev; + exit; + end; + if not TryStrToFloat(StdDev.Text, x) then + begin + AMsg := 'Sample standard deviation is not a valid number.'; + AControl := StdDev; + exit; + end; + end; + + if CInterval.Text = '' then + begin + AMsg := 'Confidence level is not specified.'; + AControl := CInterval; + exit; + end; + if not TryStrToFloat(CInterval.Text, x) then + begin + AMsg := 'Confidence level is not a valid number.'; + AControl := CInterval; + exit; + end; + + Result := true; +end; + +initialization + {$I onesampunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/cchartunit.lfm b/applications/lazstats/source/forms/analysis/statistical_process_control/cchartunit.lfm new file mode 100644 index 000000000..2a5c12c93 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/cchartunit.lfm @@ -0,0 +1,235 @@ +object cChartFrm: TcChartFrm + Left = 677 + Height = 316 + Top = 312 + Width = 445 + AutoSize = True + Caption = 'Defects C Chart' + ClientHeight = 316 + ClientWidth = 445 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Selection Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = MeasEdit + AnchorSideTop.Control = Owner + Left = 209 + Height = 15 + Top = 8 + Width = 120 + BorderSpacing.Top = 8 + Caption = 'Measurement Variable:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = SigmaOpts + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 242 + Top = 25 + Width = 193 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + OnClick = VarListClick + TabOrder = 0 + end + object MeasEdit: TEdit + AnchorSideLeft.Control = SigmaOpts + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 209 + Height = 23 + Top = 25 + Width = 228 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 1 + Text = 'MeasEdit' + end + object SigmaOpts: TRadioGroup + AnchorSideTop.Control = MeasEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 209 + Height = 118 + Top = 80 + Width = 228 + Anchors = [akTop, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Top = 32 + BorderSpacing.Right = 8 + Caption = 'No. of Sigma Units for UCL and LCL' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 5 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 4 + ClientHeight = 98 + ClientWidth = 224 + ItemIndex = 0 + Items.Strings = ( + '3 Sigma (Default)' + '2 Sigma' + '1 Sigma' + 'X Sigmas where X = ' + ) + TabOrder = 2 + object Label3: TLabel + Left = 138 + Height = 19 + Top = 6 + Width = 80 + Caption = ' ' + ParentColor = False + end + object Label4: TLabel + Left = 138 + Height = 19 + Top = 27 + Width = 80 + Caption = ' ' + ParentColor = False + end + object Label5: TLabel + Left = 138 + Height = 19 + Top = 48 + Width = 80 + Caption = ' ' + ParentColor = False + end + object XSigmaEdit: TEdit + Left = 138 + Height = 23 + Top = 69 + Width = 80 + Alignment = taRightJustify + TabOrder = 2 + Text = 'XSigmaEdit' + end + end + object Bevel2: TBevel + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + Left = 0 + Height = 8 + Top = 267 + Width = 445 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + Left = 8 + Height = 25 + Top = 283 + Width = 429 + Align = alBottom + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 25 + ClientWidth = 429 + TabOrder = 3 + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ComputeBtn + Left = 228 + Height = 25 + Top = 0 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = CloseBtn + Left = 290 + Height = 25 + Top = 0 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object HelpBtn: TButton + Tag = 141 + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ResetBtn + AnchorSideRight.Control = ResetBtn + Left = 169 + Height = 25 + Top = 0 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 0 + end + object CloseBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 374 + Height = 25 + Top = 0 + Width = 55 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Close' + ModalResult = 11 + TabOrder = 3 + end + end + object Bevel1: TBevel + Left = 4 + Height = 23 + Top = 290 + Width = 25 + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/cchartunit.pas b/applications/lazstats/source/forms/analysis/statistical_process_control/cchartunit.pas new file mode 100644 index 000000000..6411806b3 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/cchartunit.pas @@ -0,0 +1,367 @@ +unit CChartUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, + MainUnit, Globals, DataProcs, OutputUnit, BlankFrmUnit, ContextHelpUnit; + +type + + { TcChartFrm } + + TcChartFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + ComputeBtn: TButton; + HelpBtn: TButton; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Panel1: TPanel; + ResetBtn: TButton; + CloseBtn: TButton; + XSigmaEdit: TEdit; + MeasEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + VarList: TListBox; + SigmaOpts: TRadioGroup; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure VarListClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure PlotMeans(var Means: DblDyneVec; NoGrps: integer; + UCL, LCL, GrandMean: double); + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + public + { public declarations } + end; + +var + cChartFrm: TcChartFrm; + +implementation + +uses + Math; + +{ TcChartFrm } + +procedure TcChartFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + MeasEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TcChartFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinWidth := SigmaOpts.Width * 3 div 4; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TcChartFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if BlankFrm = nil then + Application.CreateForm(TBlankFrm, BlankFrm); +end; + +procedure TcChartFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TcChartFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TcChartFrm.ComputeBtnClick(Sender: TObject); +var + i, MeasVar: integer; + X, size, UCL, LCL, Sigma: double; + GrandMean, meanc, stddevc: double; + means: DblDyneVec; + cellstring: string; + ColNoSelected: IntDyneVec; + NoSelected: integer; + msg: String; + C: TWinControl; + lReport: TStrings; +begin + if not Validate(msg, C) then + begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + exit; + end; + + SetLength(ColNoSelected,1); + MeasVar := 0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = MeasEdit.Text then MeasVar := i; + end; + NoSelected := 1; + ColNoSelected[0] := MeasVar; + + case SigmaOpts.ItemIndex of + 0: Sigma := 3.0; + 1: sigma := 2.0; + 2: Sigma := 1.0; + 3: Sigma := StrToFloat(XSigmaEdit.Text); + end; + + SetLength(means, NoCases + 1); + GrandMean := 0.0; + size := 0; + + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar,i])); + means[i] := X; + GrandMean := GrandMean + X; + size := size + 1; + end; + + meanc := GrandMean / size; + stddevc := sqrt(meanc); + UCL := meanc + Sigma * stddevc; + LCL := meanc - Sigma * stddevc; + + // printed results + lReport := TStringList.Create; + try + lReport.Add('DEFECTS c CONTROL CHART RESULTS'); + lReport.Add(''); + lReport.Add('Sample Number of '); + lReport.Add(' Nonconformities'); + lReport.Add('------ ----------------'); + for i := 1 to NoCases do + lReport.Add(' %3d %8.2f', [i, means[i]]); + lReport.Add('Total Nonconformities: %8.3f', [GrandMean]); + lReport.Add('No. of samples: %8d', [NoCases]); + lReport.Add('Poisson mean and variance: %8.3f', [meanc]); + lReport.Add('Lower Control Limit: %8.3f', [LCL]); + lReport.Add('Upper Control Limit: %8.3f', [UCL]); + DisplayReport(lReport); + finally + lReport.Free; + end; + + // show graph + PlotMeans(means, NoCases, UCL, LCL, meanc); + + means := nil; + ColNoSelected := nil; +end; + +procedure TcChartFrm.VarListClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if index > -1 then + begin + MeasEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; +end; + +procedure TcChartFrm.PlotMeans(var means: DblDyneVec; NoGrps: integer; UCL, + LCL, GrandMean: double); +var + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; + vhi, hwide, offset, strhi : integer; + imagehi, maxval, minval, valincr, Yvalue : double; + Title : string; +begin + maxval := -10000.0; + minval := 10000.0; + for i := 1 to NoGrps do + begin + if means[i] > maxval then maxval := means[i]; + if means[i] < minval then minval := means[i]; + end; + if UCL > maxval then maxval := UCL; + if LCL < minval then minval := LCL; + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Show; + Title := 'DEFECT CONTROL (c) CHART FOR : ' + OS3MainFrm.FileNameEdit.Text; + BlankFrm.Caption := Title; + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + vtop := 20; + vbottom := round(imagehi) - 80; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + + BlankFrm.Image1.Canvas.Brush.Color := clLtGray; + BlankFrm.Image1.Canvas.FillRect(0, 0, BlankFrm.Image1.Width, BlankFrm.Image1.Height); + + // Draw chart border + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Rectangle(hleft,vtop-10,hleft+hwide,vtop+vhi+10); + + // draw Grand Mean + ypos := round(vhi * ( (maxval - GrandMean) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.Brush.Style := bsClear; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'MEAN'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + // draw horizontal axis + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 20); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom + 20); + for i := 1 to NoGrps do + begin + ypos := vbottom + 10; + xpos := round((hwide / NoGrps)* i + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := format('%d',[i]); + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := xpos - offset; + ypos := ypos + strhi; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + xpos := 10; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:'); + end; + + // Draw vertical axis + valincr := (maxval - minval) / 10.0; + for i := 1 to 11 do + begin + Title := format('%8.2f',[maxval - ((i-1)*valincr)]); + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := 10; + Yvalue := maxval - (valincr * (i-1)); + ypos := round(vhi * ( (maxval - Yvalue) / (maxval - minval))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + + // draw lines for means of the groups + ypos := round(vhi * ( (maxval - means[1]) / (maxval - minval))); + ypos := ypos + vtop; + xpos := round((hwide / NoGrps) + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + for i := 2 to NoGrps do + begin + ypos := round(vhi * ( (maxval - means[i]) / (maxval - minval))); + ypos := ypos + vtop; + xpos := round((hwide / NoGrps)* i + hleft); + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // Draw upper and lower confidence intervals + ypos := round(vhi * ( (maxval - UCL) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'UCL'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + ypos := round(vhi * ( (maxval - LCL) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'LCL'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); +end; + +function TCChartFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + x: Double; +begin + Result := false; + + if MeasEdit.Text = '' then + begin + AMsg := 'Measurement variable not selected.'; + AControl := MeasEdit; + exit; + end; + + if SigmaOpts.ItemIndex = 3 then + begin + if XSigmaEdit.Text = '' then + begin + AMsg := 'X sigma not specified.'; + AControl := XSigmaEdit; + exit; + end; + if not TryStrToFloat(XSigmaEdit.Text, x) then + begin + AMsg := 'X sigma is not a valid number.'; + AControl := XSigmaEdit; + exit; + end; + end; + + Result := true; +end; + +initialization + {$I cchartunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/cumsumunit.lfm b/applications/lazstats/source/forms/analysis/statistical_process_control/cumsumunit.lfm new file mode 100644 index 000000000..86c406e79 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/cumsumunit.lfm @@ -0,0 +1,352 @@ +object CUMSUMFrm: TCUMSUMFrm + Left = 717 + Height = 346 + Top = 262 + Width = 476 + AutoSize = True + Caption = 'CUMSUM Chart' + ClientHeight = 346 + ClientWidth = 476 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Selection Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = GroupEdit + AnchorSideTop.Control = Owner + Left = 242 + Height = 15 + Top = 8 + Width = 77 + BorderSpacing.Top = 8 + Caption = 'Group Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = MeasEdit + AnchorSideTop.Control = GroupEdit + AnchorSideTop.Side = asrBottom + Left = 242 + Height = 15 + Top = 64 + Width = 117 + BorderSpacing.Top = 16 + Caption = 'Measurement Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 272 + Top = 25 + Width = 226 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnClick = VarListClick + TabOrder = 0 + end + object GroupEdit: TEdit + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 242 + Height = 23 + Top = 25 + Width = 226 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 1 + Text = 'GroupEdit' + end + object MeasEdit: TEdit + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 242 + Height = 23 + Top = 81 + Width = 226 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 2 + Text = 'MeasEdit' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = MeasEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 242 + Height = 107 + Top = 120 + Width = 226 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + Caption = 'CUMSUM V-Mask Specifications' + ClientHeight = 87 + ClientWidth = 222 + TabOrder = 3 + object Label4: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = DeltaEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 6 + Width = 94 + BorderSpacing.Left = 12 + Caption = 'Delta (Effect Size):' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = AlphaEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 33 + Width = 94 + BorderSpacing.Left = 12 + Caption = 'Alpha Probability:' + ParentColor = False + end + object Label6: TLabel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = BetaEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 60 + Width = 86 + BorderSpacing.Left = 12 + Caption = 'Beta Probability:' + ParentColor = False + end + object DeltaEdit: TEdit + AnchorSideLeft.Control = AlphaEdit + AnchorSideTop.Control = GroupBox1 + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 114 + Height = 23 + Top = 2 + Width = 100 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 0 + Text = 'DeltaEdit' + end + object AlphaEdit: TEdit + AnchorSideLeft.Control = Label5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = DeltaEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 114 + Height = 23 + Top = 29 + Width = 100 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + TabOrder = 1 + Text = 'AlphaEdit' + end + object BetaEdit: TEdit + AnchorSideLeft.Control = AlphaEdit + AnchorSideTop.Control = AlphaEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 114 + Height = 23 + Top = 56 + Width = 100 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + TabOrder = 2 + Text = 'BetaEdit' + end + end + object GroupBox2: TGroupBox + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 242 + Height = 51 + Top = 243 + Width = 226 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 16 + BorderSpacing.Right = 8 + Caption = 'Option:' + ClientHeight = 31 + ClientWidth = 222 + TabOrder = 4 + object TargetChk: TCheckBox + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = TargetEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 19 + Top = 2 + Width = 141 + AutoSize = False + BorderSpacing.Left = 12 + BorderSpacing.Right = 12 + Caption = 'Use Target Specification:' + TabOrder = 0 + end + object TargetEdit: TEdit + AnchorSideLeft.Control = TargetChk + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 165 + Height = 23 + Top = 0 + Width = 49 + Alignment = taRightJustify + BorderSpacing.Left = 12 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + TabOrder = 1 + Text = 'TargetEdit' + end + end + object Bevel2: TBevel + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + Left = 0 + Height = 8 + Top = 297 + Width = 476 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + Left = 0 + Height = 41 + Top = 305 + Width = 476 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + ClientHeight = 41 + ClientWidth = 476 + TabOrder = 5 + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ComputeBtn + Left = 267 + Height = 25 + Top = 8 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = CloseBtn + Left = 329 + Height = 25 + Top = 8 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object HelpBtn: TButton + Tag = 141 + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ResetBtn + Left = 208 + Height = 25 + Top = 8 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 0 + end + object CloseBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 413 + Height = 25 + Top = 8 + Width = 55 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 3 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/cumsumunit.pas b/applications/lazstats/source/forms/analysis/statistical_process_control/cumsumunit.pas new file mode 100644 index 000000000..f66aca8fd --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/cumsumunit.pas @@ -0,0 +1,538 @@ +// File for testing: "BoltSizes.laz" +// Lot No --> Group variable +// BoltLngth --> Measurement variable +// Delta --> 0.01 +// Alpha --> 0.05 +// Beta ---> 0.20 + +unit CUMSUMUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, + MainUnit, Globals, DataProcs, OutputUnit, BlankFrmUnit, ContextHelpUnit; + +type + + { TCUMSUMFrm } + + TCUMSUMFrm = class(TForm) + Bevel2: TBevel; + ComputeBtn: TButton; + HelpBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + CloseBtn: TButton; + ReturnBtn1: TButton; + TargetEdit: TEdit; + TargetChk: TCheckBox; + DeltaEdit: TEdit; + AlphaEdit: TEdit; + BetaEdit: TEdit; + GroupBox1: TGroupBox; + GroupBox2: TGroupBox; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + MeasEdit: TEdit; + GroupEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListClick(Sender: TObject); + private + { private declarations } + FAutoSized: boolean; + semean: double; + procedure PlotMeans(var Means: DblDyneVec; NoGrps: integer; GrandMean: double); + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + public + { public declarations } + end; + +var + CUMSUMFrm: TCUMSUMFrm; + +implementation + +uses + Math; + +{ TCUMSUMFrm } + +procedure TCUMSUMFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + GroupEdit.Text := ''; + MeasEdit.Text := ''; + DeltaEdit.Text := ''; + TargetEdit.Text := ''; + TargetChk.Checked := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TCUMSUMFrm.VarListClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if index > -1 then + begin + if GroupEdit.Text = '' then + GroupEdit.Text := VarList.Items[index] + else + MeasEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; +end; + +procedure TCUMSUMFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinWidth := GroupBox1.Width * 8 div 10; + VarList.Constraints.MinHeight := GroupBox2.Top + GroupBox2.Height - VarList.Top; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TCUMSUMFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if BlankFrm = nil then + Application.CreateForm(TBlankFrm, BlankFrm); + AlphaEdit.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL); + BetaEdit.Text := FormatFloat('0.00', DEFAULT_BETA_LEVEL); +end; + +procedure TCUMSUMFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TCUMSUMFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TCUMSUMFrm.ComputeBtnClick(Sender: TObject); +var + i, j, GrpVar, MeasVar, mingrp, maxgrp, G, range, grpsize : integer; + oldgrpsize : integer; + X, UCL, LCL : double; + xmin, xmax, GrandMean, GrandSD : double; + Target, GrandSum : double; + Means, StdDev, CumSums: DblDyneVec; + count : IntDyneVec; + cellstring: string; + sizeError: boolean; + ColNoSelected : IntDyneVec; + NoSelected : integer; + lReport: TStrings; + msg: String; + C: TWinControl; + + procedure CleanUp; + begin + CumSums := nil; + StdDev := nil; + Count := nil; + Means := nil; + ColNoSelected := nil; + end; + +begin + if not Validate(msg, C) then + begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + exit; + end; + + SetLength(ColNoSelected,NoVariables); + GrpVar := 1; + MeasVar := 2; + grpsize := 0; + oldgrpsize := 0; + + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = GroupEdit.Text then GrpVar := i; + if cellstring = MeasEdit.Text then MeasVar := i; + end; + NoSelected := 2; + ColNoSelected[0] := GrpVar; + ColNoSelected[1] := MeasVar; + + mingrp := 10000; + maxgrp := -10000; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); + if G < mingrp then mingrp := G; + if G > maxgrp then maxgrp := G; + end; + range := maxgrp - mingrp + 1; + + SetLength(means,range); + SetLength(count,range); + SetLength(stddev,range); + SetLength(cumsums,range); + + for i := 0 to range-1 do + begin + count[i] := 0; + means[i] := 0.0; + stddev[i] := 0.0; + cumsums[i] := 0.0; + end; + semean := 0.0; + GrandMean := 0.0; + sizeerror := false; + GrandSum := 0.0; + if TargetChk.Checked then Target := StrToFloat(TargetEdit.Text) + else Target := 0.0; + + // calculate group ranges, grand mean, group sd's, semeans + for j := 1 to range do // groups + begin + xmin := 10000.0; + xmax := -10000.0; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); + G := G - mingrp + 1; + if G = j then + begin + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar,i])); + if X > xmax then xmax := X; + if X < xmin then xmin := X; + count[G-1] := count[G-1] + 1; + stddev[G-1] := stddev[G-1] + (X * X); + semean := semean + (X * X); + means[G-1] := means[G-1] + X; + GrandMean := GrandMean + X; + end; + end; // next case + stddev[j-1] := stddev[j-1] - (means[j-1] * means[j-1] / count[j-1]); + stddev[j-1] := stddev[j-1] / (count[j-1] - 1); + stddev[j-1] := sqrt(stddev[j-1]); + grpsize := count[j-1]; + means[j-1] := means[j-1] / count[j-1]; + if j = 1 then oldgrpsize := grpsize; + if oldgrpsize <> grpsize then sizeerror := true; + end; // next group + + // now get cumulative deviations of means from target + if Target = 0.0 then Target := means[range-1]; + cumsums[0] := means[0] - Target; + GrandSum := GrandSum + (means[0] - Target); + for j := 2 to range do + begin + cumsums[j-1] := cumsums[j-2] + (means[j-1] - Target); + GrandSum := GrandSum + (means[j-1] - Target); + end; + + if (grpsize < 2) or (grpsize > 25) or (sizeerror) then + begin + MessageDlg('Group sizes error.', mtError, [mbOK], 0); + CleanUp; + exit; + end; + + semean := semean - ((GrandMean * GrandMean) / NoCases); + semean := semean / (NoCases - 1); + semean := sqrt(semean); + GrandSD := semean; + semean := semean / sqrt(NoCases); + GrandMean := GrandMean / NoCases; // mean of all observations + GrandSum := GrandSum / range; // mean of the group means + UCL := GrandMean + (3.0 * semean); + LCL := GrandMean - (3.0 * semean); + if (LCL < 0.0) then LCL := 0.0; + + // printed results + lReport := TStringList.Create; + try + lReport.Clear; + lReport.Add('CUMSUM Chart Results'); + lReport.Add(''); + lReport.Add('Group Size Mean Std.Dev. Cum.Dev. of'); + lReport.Add(' Mean from Target'); + lReport.Add('----- ---- -------- -------- ----------------'); + for i := 0 to range-1 do + lReport.Add(' %3d %3d %8.2f %8.2f %8.2f', [i+1, count[i], means[i], stddev[i], cumsums[i]]); + lReport.Add(''); + lReport.Add('Mean of group deviations: %8.3f', [GrandSum]); + lReport.Add('Mean of all observations: %8.3f', [GrandMean]); + lReport.Add('Std. Dev. of Observations: %8.3f', [GrandSD]); + lReport.Add('Standard Error of Mean: %8.3f', [seMean]); + lReport.Add('Target Specification: %8.3f', [Target]); + lReport.Add('Lower Control Limit: %8.3f', [LCL]); + lReport.Add('Upper Control Limit: %8.3f', [UCL]); + + DisplayReport(lReport); + finally + lReport.Free; + end; + + // show graph + PlotMeans(cumsums, range, GrandSum); + + // Clean up + CleanUp; +end; + +procedure TCUMSUMFrm.PlotMeans(var Means: DblDyneVec; NoGrps: integer; + GrandMean: double); +var + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; + vhi, hwide, offset, strhi, grpnospc, distx : integer; + imagehi, maxval, minval, valincr, Yvalue : double; + alpha, beta, delta, gamma, theta, kfactor, d : double; + Title : string; +begin + maxval := -10000.0; + minval := 10000.0; + for i := 0 to NoGrps-1 do + begin + if means[i] > maxval then maxval := means[i]; + if means[i] < minval then minval := means[i]; + end; +// BlankFrm.Image1.Canvas.Clear; + BlankFrm.Show; + Title := 'CUMSUM CHART FOR : ' + OS3MainFrm.FileNameEdit.Text; + BlankFrm.Caption := Title; + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + vtop := 20; + vbottom := round(imagehi) - 80; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + + BlankFrm.Image1.Canvas.Brush.Color := clLtGray; + BlankFrm.Image1.Canvas.FillRect(0, 0, BlankFrm.Image1.Width, BlankFrm.Image1.Height); + + // Draw chart border + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Rectangle(hleft,vtop-10,hleft+hwide,vtop+vhi+10); + + // draw Grand Mean + ypos := round(vhi * ( (maxval - GrandMean) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'AVG.DEV.'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.Brush.Style := bsClear; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + // draw horizontal axis + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 20); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom + 20); + for i := 1 to NoGrps do + begin + ypos := vbottom + 10; + xpos := round((hwide / NoGrps)* i + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := format('%d',[i]); + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := xpos - offset; + ypos := ypos + strhi; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + xpos := 10; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:'); + end; + + // Draw vertical axis + valincr := (maxval - minval) / 10.0; + for i := 1 to 11 do + begin + Title := format('%8.2f',[maxval - ((i-1)*valincr)]); + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := 10; + Yvalue := maxval - (valincr * (i-1)); + ypos := round(vhi * ( (maxval - Yvalue) / (maxval - minval))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + + // draw lines for means of the groups + ypos := round(vhi * ( (maxval - means[0]) / (maxval - minval))); + ypos := ypos + vtop; + xpos := round((hwide / NoGrps) + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + for i := 2 to NoGrps do + begin + ypos := round(vhi * ( (maxval - means[i-1]) / (maxval - minval))); + ypos := ypos + vtop; + xpos := round((hwide / NoGrps)* i + hleft); + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // Draw V Mask + if DeltaEdit.Text = '' then exit; // not elected + BlankFrm.Image1.Canvas.Pen.Color := clBlue; + delta := StrToFloat(DeltaEdit.Text); + gamma := delta / semean; + alpha := StrToFloat(AlphaEdit.Text); + beta := StrToFloat(BetaEdit.Text); + kfactor := 2.0 * semean; + d := (2.0 / (gamma * gamma)) * ln((1.0 - beta)/alpha); + theta := arctan(delta / (2.0 * kfactor)); + grpnospc := round(hwide / NoGrps); + xpos := hleft + (grpnospc * (NoGrps)); // last group + ypos := round(vhi * ( (maxval - means[NoGrps-1]) / (maxval - minval))); + ypos := ypos + vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := round(xpos + (d * grpnospc / hwide)); // scaled d + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); // line 0 to A + + // draw upper angle line + xpos := hleft + (grpnospc * NoGrps); // last group + xpos := round(xpos + (d * grpnospc / hwide)); // plus scaled d + ypos := round(vhi * ( (maxval - means[NoGrps-1]) / (maxval - minval))); + ypos := ypos + vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := vtop; // draw angle up to top of graph + distx := round(vhi / tan(theta)); // x unscaled distance + xpos := round(xpos - (distx * grpnospc / hwide)); + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + + // draw lower angle line + xpos := hleft + (grpnospc * NoGrps); // last group + xpos := round(xpos + (d * grpnospc / hwide)); // plus scaled d + ypos := round(vhi * ( (maxval - means[NoGrps-1]) / (maxval - minval))); + ypos := ypos + vtop; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := vbottom; + xpos := round(xpos - (distx * grpnospc / hwide)); + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + BlankFrm.Image1.Canvas.Pen.Color := clBlack; +end; + +function TCUMSUMFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + x: Double; +begin + Result := False; + + if GroupEdit.Text = '' then + begin + AMsg := 'Group variable not specified.'; + AControl := GroupEdit; + exit; + end; + + if MeasEdit.Text = '' then + begin + AMsg := 'Measurement variable not specified.'; + AControl := MeasEdit; + exit; + end; + + if DeltaEdit.Text = '' then + begin + AMsg := 'Delta parameter not specified.'; + AControl := DeltaEdit; + exit; + end; + if not TryStrToFloat(DeltaEdit.Text, x) then + begin + AMsg := 'Delta parameter is not a valid number.'; + AControl := DeltaEdit; + exit; + end; + + if AlphaEdit.Text = '' then + begin + AMsg := 'Alpha probability is not specified.'; + AControl := AlphaEdit; + exit; + end; + if not TryStrToFloat(AlphaEdit.Text, x) then + begin + AMsg := 'Alpha probability is not a valid number.'; + AControl := AlphaEdit; + exit; + end; + + if BetaEdit.Text = '' then + begin + AMsg := 'Beta probability is not specified.'; + AControl := BetaEdit; + exit; + end; + if not TryStrtoFloat(BetaEdit.Text, x) then + begin + AMsg := 'Beta probability is not a valid number,'; + AControl := BetaEdit; + exit; + end; + + if TargetChk.Checked then + begin + if TargetEdit.Text = '' then + begin + AMsg := 'Target is not specified.'; + AControl := TargetEdit; + exit; + end; + if not TryStrToFloat(TargetEdit.Text, x) then + begin + AMsg := 'Target specification is not a valid number.'; + AControl := TargetEdit; + exit; + end; + end; + + Result := true; +end; + +initialization + {$I cumsumunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/pchartunit.lfm b/applications/lazstats/source/forms/analysis/statistical_process_control/pchartunit.lfm new file mode 100644 index 000000000..4c2644413 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/pchartunit.lfm @@ -0,0 +1,287 @@ +object pChartFrm: TpChartFrm + Left = 504 + Height = 371 + Top = 382 + Width = 511 + AutoSize = True + Caption = 'p Control Chart' + ClientHeight = 371 + ClientWidth = 511 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Selection Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = MeasEdit + AnchorSideTop.Control = Owner + Left = 264 + Height = 15 + Top = 8 + Width = 117 + BorderSpacing.Top = 8 + Caption = 'Measurement Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Label4 + AnchorSideTop.Control = NEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NEdit + Left = 264 + Height = 15 + Top = 76 + Width = 167 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Right = 8 + Caption = 'No. of Parts Sampled:' + ParentColor = False + end + object Label4: TLabel + AnchorSideTop.Control = PEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = PEdit + Left = 264 + Height = 15 + Top = 107 + Width = 167 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Expected Proportion of Defects:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = SigmaOpts + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 297 + Top = 25 + Width = 248 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnClick = VarListClick + TabOrder = 0 + end + object MeasEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 264 + Height = 23 + Top = 25 + Width = 239 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 1 + Text = 'MeasEdit' + end + object NEdit: TEdit + AnchorSideTop.Control = MeasEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 439 + Height = 23 + Top = 72 + Width = 64 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 24 + BorderSpacing.Right = 8 + TabOrder = 2 + Text = 'NEdit' + end + object PEdit: TEdit + AnchorSideTop.Control = NEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 439 + Height = 23 + Top = 103 + Width = 64 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + TabOrder = 3 + Text = 'Edit1' + end + object SigmaOpts: TRadioGroup + AnchorSideLeft.Control = Label4 + AnchorSideTop.Control = PEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 264 + Height = 118 + Top = 150 + Width = 239 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Top = 24 + BorderSpacing.Right = 8 + Caption = 'No. Of Sigma Units for UCL and LCL' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 4 + ClientHeight = 98 + ClientWidth = 235 + ItemIndex = 0 + Items.Strings = ( + '3 Sigma (Default)' + '2 Sigma' + '1 Sigma' + 'X Sigma where X = ' + ) + TabOrder = 4 + object Label5: TLabel + Left = 143 + Height = 19 + Top = 6 + Width = 80 + Caption = ' ' + ParentColor = False + end + object Label6: TLabel + Left = 143 + Height = 19 + Top = 27 + Width = 80 + Caption = ' ' + ParentColor = False + end + object Label7: TLabel + Left = 143 + Height = 19 + Top = 48 + Width = 80 + Caption = ' ' + ParentColor = False + end + object XSigmaEdit: TEdit + Left = 143 + Height = 23 + Top = 69 + Width = 80 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 2 + Text = 'XSigmaEdit' + end + end + object Bevel2: TBevel + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + Left = 0 + Height = 8 + Top = 322 + Width = 511 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + Left = 8 + Height = 25 + Top = 338 + Width = 495 + Align = alBottom + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 25 + ClientWidth = 495 + TabOrder = 5 + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ComputeBtn + Left = 294 + Height = 25 + Top = 0 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = CloseBtn + Left = 356 + Height = 25 + Top = 0 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object HelpBtn: TButton + Tag = 141 + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ResetBtn + AnchorSideRight.Control = ResetBtn + Left = 235 + Height = 25 + Top = 0 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 0 + end + object CloseBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 440 + Height = 25 + Top = 0 + Width = 55 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Close' + ModalResult = 11 + TabOrder = 3 + end + end +end diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/pchartunit.pas b/applications/lazstats/source/forms/analysis/statistical_process_control/pchartunit.pas new file mode 100644 index 000000000..f2e714ff5 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/pchartunit.pas @@ -0,0 +1,410 @@ +// File for testing: "defects.laz" +// Defects --> Measurement Variable +// No of parts sampled ---> 1000 +// Expected proportion of defects --> 0.01 + +unit PChartUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + MainUnit, Globals, Math, OutputUnit, Buttons, BlankFrmUnit, ContextHelpUnit; + +type + + { TpChartFrm } + + TpChartFrm = class(TForm) + Bevel2: TBevel; + ComputeBtn: TButton; + HelpBtn: TButton; + Label5: TLabel; + Label6: TLabel; + Label7: TLabel; + Panel1: TPanel; + ResetBtn: TButton; + CloseBtn: TButton; + XSigmaEdit: TEdit; + NEdit: TEdit; + PEdit: TEdit; + Label3: TLabel; + Label4: TLabel; + MeasEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + SigmaOpts: TRadioGroup; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure PlotMeans(var means: DblDyneVec; NoGrps: integer; + UCL, LCL, GrandMean, Target: double); + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + public + { public declarations } + end; + +var + pChartFrm: TpChartFrm; + +implementation + +{ TpChartFrm } + +procedure TpChartFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + MeasEdit.Text := ''; + NEdit.Text := ''; + PEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TpChartFrm.VarListClick(Sender: TObject); +var + index : integer; +begin + index := VarList.ItemIndex; + if index > -1 then begin + MeasEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; +end; + +procedure TpChartFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinHeight := SigmaOpts.Top + SigmaOpts.Height - VarList.Top; + VarList.Constraints.MinWidth := SigmaOpts.Width * 3 div 4; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TpChartFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if BlankFrm = nil then + Application.CreateForm(TBlankfrm, BlankFrm); +end; + +procedure TpChartFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TpChartFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TpChartFrm.ComputeBtnClick(Sender: TObject); +var + P, N, variance, stddev, UCL, LCL, X, Sigma, AVG: double; + i, measvar: integer; + cellstring: string; + obsp: DblDyneVec; + msg: String; + C: TWinControl; + lReport: TStrings; +begin + if not Validate(msg, C) then + begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + exit; + end; + + AVG := 0.0; + measvar := 1; + Sigma := 3; + N := StrToFloat(NEdit.Text); + P := StrToFloat(PEdit.Text); + case SigmaOpts.ItemIndex of + 0: Sigma := 3.0; + 1: Sigma := 2.0; + 2: Sigma := 1.0; + 3: Sigma := StrToFloat(XSigmaEdit.Text); + end; + + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = MeasEdit.Text then measvar := i; + end; + variance := P * (1.0 - P) / N; + stddev := Sqrt(variance); + SetLength(obsp, NoCases + 1); + for i := 1 to NoCases do + begin + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[measvar,i])); + X := X / N; + obsp[i] := X; + AVG := AVG + X; + end; + AVG := AVG / NoCases; + UCL := P + Sigma * stddev; + LCL := P - Sigma * stddev; + + // output results + lReport := TStringList.Create; + try + lReport.Add('DEFECTS P CONTROL CHART RESULS'); + lReport.Add(''); + lReport.Add('Sample No. Proportion'); + lReport.Add('---------- ----------'); + for i := 1 to NoCases do + lReport.Add(' %5d %6.3f', [i, obsp[i]]); + lReport.Add(''); + lReport.Add('Target proportion: %6.4f', [P]); + lReport.Add('Sample size for each observation: %6.0f', [N]); + lReport.Add('Average proportion observed %6.4f', [AVG]); + + DisplayReport(lReport); + finally + lReport.Free; + end; + + // Now create plot + PlotMeans(obsp,NoCases,UCL,LCL, Avg, P); + + obsp := nil; +end; + +procedure TpChartFrm.PlotMeans(var Means: DblDyneVec; NoGrps: integer; + UCL, LCL, GrandMean, Target: double); +var + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; + vhi, hwide, offset, strhi, oldxpos : integer; + imagehi, maxval, minval, valincr, Yvalue : double; + Title : string; +begin + maxval := -10000.0; + minval := 10000.0; + for i := 1 to NoGrps do + begin + if means[i] > maxval then maxval := means[i]; + if means[i] < minval then minval := means[i]; + end; + if UCL > maxval then maxval := UCL; + if LCL < minval then minval := LCL; + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Show; + Title := 'p CONTROL CHART FOR ' + OS3MainFrm.FileNameEdit.Text; + BlankFrm.Caption := Title; + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + vtop := 20; + vbottom := round(imagehi) - 80; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + + BlankFrm.Image1.Canvas.Brush.Color := clLtGray; + BlankFrm.Image1.Canvas.FillRect(0, 0, BlankFrm.Image1.Width, BlankFrm.Image1.Height); + + // Draw chart border + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Rectangle(hleft,vtop-10,hleft+hwide,vtop+vhi+10); + + // draw Grand Mean + ypos := round(vhi * ( (maxval - GrandMean) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clBlue; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'MEAN'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.Brush.Style := bsClear; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + // draw target + ypos := round(vhi * ( (maxval - Target) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'TARGET'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.Brush.Style := bsClear; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + // draw horizontal axis + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 20); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom + 20); + oldxpos := 0; + for i := 1 to NoGrps do + begin + ypos := vbottom + 10; + xpos := round((hwide / NoGrps)* i + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := format('%d',[i]); + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := xpos - offset; + ypos := ypos + strhi; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + if xpos > oldxpos then + begin + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + oldxpos := xpos + (offset * 2); + end; + xpos := 10; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:'); + end; + + // Draw vertical axis + valincr := (maxval - minval) / 10.0; + for i := 1 to 11 do + begin + Title := format('%.3f',[maxval - ((i-1)*valincr)]); + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := 10; + Yvalue := maxval - (valincr * (i-1)); + ypos := round(vhi * ( (maxval - Yvalue) / (maxval - minval))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + + // draw lines for means of the groups + ypos := round(vhi * ( (maxval - means[1]) / (maxval - minval))); + ypos := ypos + vtop; + xpos := round((hwide / NoGrps) + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + for i := 2 to NoGrps do + begin + ypos := round(vhi * ( (maxval - means[i]) / (maxval - minval))); + ypos := ypos + vtop; + xpos := round((hwide / NoGrps)* i + hleft); + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // Draw upper and lower confidence intervals + ypos := round(vhi * ( (maxval - UCL) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'UCL'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + ypos := round(vhi * ( (maxval - LCL) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'LCL'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); +end; + +function TPChartFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + n: Integer; + x: Double; +begin + Result := false; + + if MeasEdit.Text = '' then + begin + AMsg := 'Measurement variable not specified.'; + AControl := MeasEdit; + exit; + end; + + if NEdit.Text = '' then + begin + AMsg := 'Number of sampled parts is not specified.'; + AControl := NEdit; + exit; + end; + if not TryStrToInt(NEdit.Text, n) then + begin + AMsg := 'Number of sampled parts is not valid.'; + AControl := NEdit; + exit; + end; + + if PEdit.Text = '' then + begin + AMsg := 'Expected proportion of defects is not specified.'; + AControl := PEdit; + exit; + end; + if not TryStrToFloat(PEdit.Text, x) then + begin + AMsg := 'Expected proporton of defects is not a valid number.'; + AControl := PEdit; + exit; + end; + + if SigmaOpts.ItemIndex = 3 then + begin + if XSigmaEdit.Text = '' then + begin + AMsg := 'X Sigma is not specified.'; + AControl := XSigmaEdit; + exit; + end; + if not TryStrToFloat(XSigmaEdit.Text, x) then + begin + AMsg := 'X Sigma is not a valid number.'; + AControl := XSigmaEdit; + exit; + end; + end; + + Result := true; +end; + +initialization + {$I pchartunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.lfm b/applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.lfm new file mode 100644 index 000000000..9202f6d5e --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.lfm @@ -0,0 +1,220 @@ +object RChartFrm: TRChartFrm + Left = 688 + Height = 297 + Top = 126 + Width = 382 + AutoSize = True + Caption = 'Range Charting' + ChildSizing.ControlsPerLine = 1 + ClientHeight = 297 + ClientWidth = 382 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Panel1: TPanel + Left = 8 + Height = 25 + Top = 264 + Width = 366 + Align = alBottom + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 25 + ClientWidth = 366 + TabOrder = 1 + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ComputeBtn + Left = 165 + Height = 25 + Top = 0 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = CloseBtn + Left = 227 + Height = 25 + Top = 0 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object HelpBtn: TButton + Tag = 141 + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ResetBtn + AnchorSideRight.Control = ResetBtn + Left = 106 + Height = 25 + Top = 0 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 0 + end + object CloseBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 311 + Height = 25 + Top = 0 + Width = 55 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Close' + ModalResult = 11 + TabOrder = 3 + end + end + object Panel4: TPanel + Left = 0 + Height = 256 + Top = 0 + Width = 382 + Align = alClient + Anchors = [akTop, akLeft, akRight] + BevelOuter = bvNone + ClientHeight = 256 + ClientWidth = 382 + TabOrder = 0 + object Bevel1: TBevel + AnchorSideLeft.Control = Panel4 + AnchorSideLeft.Side = asrCenter + Left = 156 + Height = 16 + Top = 0 + Width = 71 + Shape = bsSpacer + end + object Label2: TLabel + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel4 + Left = 235 + Height = 15 + Top = 8 + Width = 77 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Group Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupEdit + AnchorSideTop.Side = asrBottom + Left = 235 + Height = 15 + Top = 64 + Width = 117 + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + Caption = 'Measurement Variable' + ParentColor = False + end + object GroupEdit: TEdit + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel4 + AnchorSideRight.Side = asrBottom + Left = 235 + Height = 23 + Top = 25 + Width = 139 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 1 + Text = 'GroupEdit' + end + object MeasEdit: TEdit + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel4 + AnchorSideRight.Side = asrBottom + Left = 235 + Height = 23 + Top = 81 + Width = 139 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 2 + Text = 'MeasEdit' + end + object Label1: TLabel + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = Panel4 + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Selection Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Bevel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel4 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 223 + Top = 25 + Width = 219 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + OnClick = VarListClick + TabOrder = 0 + end + end + object Bevel2: TBevel + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + Left = 0 + Height = 8 + Top = 248 + Width = 382 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.pas b/applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.pas new file mode 100644 index 000000000..a6780bb56 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/rchartunit.pas @@ -0,0 +1,424 @@ +// File for testing: "boltsize.laz" +// LotNo --> Group Variable +// BoltLngth --> Measurement Variable + +unit RChartUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Printers, ExtCtrls, Buttons, + MainUnit, Globals, OutputUnit, GraphLib, BlankFrmUnit, ContextHelpUnit; + + +type + + { TRChartFrm } + + TRChartFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + HelpBtn: TButton; + Panel1: TPanel; + Panel4: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + MeasEdit: TEdit; + GroupEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure PlotMeans(VAR means : DblDyneVec; + NoGrps : integer; + UCL, LCL, GrandMean : double); + public + { public declarations } + end; + +var + RChartFrm: TRChartFrm; + +implementation + +uses + Math; + +{ TRChartFrm } + +procedure TRChartFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + GroupEdit.Text := ''; + MeasEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TRChartFrm.VarListClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if index > -1 then + begin + if GroupEdit.Text = '' then + GroupEdit.Text := VarList.Items[index] + else + MeasEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; +end; + +procedure TRChartFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TRChartFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if BlankFrm = nil then + Application.CreateForm(TBlankfrm, BlankFrm); +end; + +procedure TRChartFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TRChartFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TRChartFrm.ComputeBtnClick(Sender: TObject); +var + i, j, GrpVar, MeasVar, mingrp, maxgrp, G, range, grpsize : integer; + oldgrpsize : integer; + X, UCL, LCL: double; + xmin, xmax, GrandMean, GrandSD, semean, D3Value, D4Value : double; + GrandRange : double; + means, stddev, ranges : DblDyneVec; + count : IntDyneVec; + cellstring: string; + sizeError : boolean; + lReport: TStrings; +const + D3: array[1..24] of double = ( + 0,0,0,0,0,0.076,0.136,0.184,0.223,0.256,0.283,0.307,0.328, + 0.347,0.363,0.378,0.391,0.403,0.415,0.425,0.434,0.443, + 0.451,0.459 + ); + D4: array[1..24] of double = ( + 3.267, 2.574, 2.282, 2.114, 2.004, 1.924, 1.864, 1.816,1.777, + 1.744, 1.717, 1.693, 1.672, 1.653, 1.637, 1.622, 1.608,1.597, + 1.585, 1.575, 1.566, 1.557, 1.548, 1.541 + ); +begin + if (GroupEdit.Text = '') then + begin + MessageDlg('Group variable is not specified.', mtError, [mbOk], 0); + exit; + end; + + if (MeasEdit.Text = '') then + begin + MessageDlg('Measurement variable is not specified.', mtError, [mbOK], 0); + exit; + end; + + GrpVar := 1; + MeasVar := 2; + grpsize := 0; + oldgrpsize := 0; + + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = GroupEdit.Text then GrpVar := i; + if cellstring = MeasEdit.Text then MeasVar := i; + end; + + mingrp := MaxInt; + maxgrp := -MaxInt; + for i := 1 to NoCases do + begin + G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); + if G < mingrp then mingrp := G; + if G > maxgrp then maxgrp := G; + end; + range := maxgrp - mingrp + 1; + + SetLength(means,range); + SetLength(count,range); + SetLength(stddev,range); + SetLength(ranges,range); + + for i := 0 to range-1 do + begin + count[i] := 0; + means[i] := 0.0; + stddev[i] := 0.0; + ranges[i] := 0.0; + end; + semean := 0.0; + GrandMean := 0.0; + GrandRange := 0.0; + sizeError := false; + + // calculate group ranges, grand mean, group sd's, semeans + for j := 1 to range do // groups + begin + xmin := 1E308; + xmax := -1E308; + for i := 1 to NoCases do + begin + G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); + G := G - mingrp + 1; + if G = j then + begin + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar,i])); + if X > xmax then xmax := X; + if X < xmin then xmin := X; + means[G-1] := means[G-1] + X; + count[G-1] := count[G-1] + 1; + stddev[G-1] := stddev[G-1] + X * X; + semean := semean + X * X; + GrandMean := GrandMean + X; + end; + end; // next case + + ranges[j-1] := xmax - xmin; + GrandRange := GrandRange + ranges[j-1]; + grpsize := count[j-1]; + if j = 1 then oldgrpsize := grpsize; + if oldgrpsize <> grpsize then sizeError := true; + end; + + if (grpsize < 2) or (grpsize > 25) or sizeError then + begin + MessageDlg('Group sizes error.', mtError, [mbOk], 0); + exit; + end; + + for i := 0 to range-1 do + begin + stddev[i] := stddev[i] - sqr(means[i]) / count[i]; + stddev[i] := stddev[i] / (count[i] - 1); + stddev[i] := sqrt(stddev[i]); + means[i] := means[i] / count[i]; + end; + semean := semean - GrandMean * GrandMean / NoCases; + semean := semean / (NoCases - 1); + semean := sqrt(semean); + GrandSD := semean; + semean := semean / sqrt(NoCases); + GrandMean := GrandMean / NoCases; + GrandRange := GrandRange / range; + D3Value := D3[grpsize-1]; + D4Value := D4[grpsize-1]; +{ + C4 = sqrt(2.0 / (double(grpsize)-1)); + double gamma = exp(gammln(double(grpsize)/2.0)); + C4 *= gamma; + gamma = exp(gammln(double(grpsize-1)/2.0)); + C4 /= gamma; +} + UCL := D4Value * GrandRange; + LCL := D3Value * GrandRange; + + // printed results + lReport := TStringList.Create; + try + lReport.Add('X Bar Chart Results'); + lReport.Add(''); + lReport.Add('Group Size Mean Range Std.Dev.'); + lReport.Add('----- ---- --------- ------- --------'); + for i := 0 to range-1 do + lReport.Add(' %3d %3d %8.2f %8.2f %8.2f', [i+1, count[i], means[i], ranges[i], stddev[i]]); + lReport.Add(''); + lReport.Add('Grand Mean: %8.3f', [GrandMean]); + lReport.Add('Standard Deviation: %8.3f', [GrandSD]); + lReport.Add('Standard Error of Mean: %8.3f', [semean]); + lReport.Add('Mean Range: %8.3f', [GrandRange]); + lReport.Add('Lower Control Limit: %8.3f', [LCL]); + lReport.Add('Upper Control Limit: %8.3f', [UCL]); + + DisplayReport(lReport); + finally + lReport.Free; + end; + + // show graph + PlotMeans(ranges, range, UCL, LCL, GrandRange); + + // Clean up + ranges := nil; + stddev := nil; + count := nil; + means := nil; +end; + +procedure TRChartFrm.PlotMeans(var means: DblDyneVec; NoGrps: integer; UCL, + LCL, GrandMean: double); +var + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; + vhi, hwide, offset, strhi : integer; + imagehi, maxval, minval, valincr, Yvalue : double; + Title : string; +begin + maxval := -10000.0; + minval := 10000.0; + for i := 0 to NoGrps-1 do + begin + if means[i] > maxval then maxval := means[i]; + if means[i] < minval then minval := means[i]; + end; + if UCL > maxval then maxval := UCL; + if LCL < minval then minval := LCL; + + BlankFrm.Show; + Title := 'RANGE CHART FOR : ' + OS3MainFrm.FileNameEdit.Text; + BlankFrm.Caption := Title; + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + vtop := 20; + vbottom := round(imagehi) - 80; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + BlankFrm.Image1.Canvas.Brush.Color := clLtGray; + BlankFrm.Image1.Canvas.FillRect(0, 0, BlankFrm.Image1.Width, BlankFrm.Image1.Height); + + // Draw chart border + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Rectangle(hleft,vtop-10,hleft+hwide,vtop+vhi+10); + + // draw Grand Mean + ypos := round(vhi * ( (maxval - GrandMean) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'MEAN'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.Brush.Style := bsClear; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + // draw horizontal axis + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 20); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom + 20); + for i := 1 to NoGrps do + begin + ypos := vbottom + 10; + xpos := round((hwide / NoGrps)* i + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := format('%d',[i]); + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := xpos - offset; + ypos := ypos + strhi; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + xpos := 10; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:'); + end; + + // Draw vertical axis + valincr := (maxval - minval) / 10.0; + for i := 1 to 11 do + begin + Title := format('%8.2f',[maxval - ((i-1)*valincr)]); + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := 10; + Yvalue := maxval - (valincr * (i-1)); + ypos := round(vhi * ( (maxval - Yvalue) / (maxval - minval))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + + // draw lines for means of the groups + ypos := round(vhi * ( (maxval - means[0]) / (maxval - minval))); + ypos := ypos + vtop; + xpos := round((hwide / NoGrps) + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + for i := 2 to NoGrps do + begin + ypos := round(vhi * ( (maxval - means[i-1]) / (maxval - minval))); + ypos := ypos + vtop; + xpos := round((hwide / NoGrps)* i + hleft); + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // Draw upper and lower confidence intervals + ypos := round(vhi * ( (maxval - UCL) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'UCL'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + ypos := round(vhi * ( (maxval - LCL) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'LCL'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); +end; + +initialization + {$I rchartunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/sigmachartunit.lfm b/applications/lazstats/source/forms/analysis/statistical_process_control/sigmachartunit.lfm new file mode 100644 index 000000000..09b744969 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/sigmachartunit.lfm @@ -0,0 +1,194 @@ +object SigmaChartFrm: TSigmaChartFrm + Left = 533 + Height = 298 + Top = 243 + Width = 397 + AutoSize = True + Caption = 'Sigma Charting' + ClientHeight = 298 + ClientWidth = 397 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Selection Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = GroupEdit + AnchorSideTop.Control = Owner + Left = 234 + Height = 15 + Top = 8 + Width = 77 + BorderSpacing.Top = 8 + Caption = 'Group Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = MeasEdit + Left = 234 + Height = 15 + Top = 80 + Width = 117 + Caption = 'Measurement Variable' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupEdit + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 226 + Top = 23 + Width = 218 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + OnClick = VarListClick + TabOrder = 0 + end + object GroupEdit: TEdit + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 234 + Height = 23 + Top = 25 + Width = 155 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 1 + Text = 'GroupEdit' + end + object MeasEdit: TEdit + AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 234 + Height = 23 + Top = 96 + Width = 155 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 2 + Text = 'MeasEdit' + end + object Panel1: TPanel + Left = 8 + Height = 25 + Top = 265 + Width = 381 + Align = alBottom + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 25 + ClientWidth = 381 + TabOrder = 3 + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ComputeBtn + Left = 180 + Height = 25 + Top = 0 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = CloseBtn + Left = 242 + Height = 25 + Top = 0 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object HelpBtn: TButton + Tag = 141 + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ResetBtn + AnchorSideRight.Control = ResetBtn + Left = 121 + Height = 25 + Top = 0 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 0 + end + object CloseBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 326 + Height = 25 + Top = 0 + Width = 55 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Close' + ModalResult = 11 + TabOrder = 3 + end + end + object Bevel2: TBevel + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + Left = 0 + Height = 8 + Top = 249 + Width = 397 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 162 + Height = 16 + Top = 0 + Width = 72 + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/sigmachartunit.pas b/applications/lazstats/source/forms/analysis/statistical_process_control/sigmachartunit.pas new file mode 100644 index 000000000..1e761a370 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/sigmachartunit.pas @@ -0,0 +1,423 @@ +unit SigmaChartUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, OutputUnit, FunctionsLib, BlankFrmUnit, ContextHelpUnit; + +type + + { TSigmaChartFrm } + + TSigmaChartFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + ComputeBtn: TButton; + HelpBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + MeasEdit: TEdit; + GroupEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + CloseBtn: TButton; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListClick(Sender: TObject); + private + { private declarations } + FAutoSized: boolean; + procedure PlotMeans(var means: DblDyneVec; + NoGrps: integer; + UCL, LCL, GrandMean: double; + TargetSpec, LowerSpec, UpperSpec: double); + public + { public declarations } + end; + +var + SigmaChartFrm: TSigmaChartFrm; + +implementation + +uses + Math; + +{ TSigmaChartFrm } + +procedure TSigmaChartFrm.ResetBtnClick(Sender: TObject); +var + i : integer; +begin + VarList.Clear; + GroupEdit.Text := ''; + MeasEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TSigmaChartFrm.VarListClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if Index > -1 then + begin + if GroupEdit.Text = '' then + GroupEdit.Text := VarList.Items[index] + else + MeasEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; +end; + +procedure TSigmaChartFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TSigmaChartFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if BlankFrm = nil then + Application.CreateForm(TBlankFrm, BlankFrm); +end; + +procedure TSigmaChartFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TSigmaChartFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TSigmaChartFrm.ComputeBtnClick(Sender: TObject); +const + D3: array[1..24] of double = ( + 0,0,0,0,0,0.076,0.136,0.184,0.223,0.256,0.283,0.307,0.328, + 0.347,0.363,0.378,0.391,0.403,0.415,0.425,0.434,0.443, + 0.451,0.459 + ); + D4 : array[1..24] of double = ( + 3.267,2.574,2.282,2.114,2.004,1.924,1.864,1.816,1.777, + 1.744,1.717,1.693,1.672,1.653,1.637,1.622,1.608,1.597, + 1.585,1.575,1.566,1.557,1.548,1.541 + ); +var + i, j, GrpVar, MeasVar, mingrp, maxgrp, G, range, grpsize : integer; + oldgrpsize : integer; + X, UCL, LCL, Sigma, UpperSpec, LowerSpec, TargetSpec : double; + xmin, xmax, GrandMean, GrandSD, semean, D3Value, D4Value : double; + GrandSigma, C4, gamma, B : double; + means, stddev: DblDyneVec; + count : IntDyneVec; + cellstring: string; + sizeerror : boolean; + lReport: TStrings; + + procedure CleanUp; + begin + stddev := nil; + count := nil; + means := nil; + end; + +begin + if (GroupEdit.Text = '') then + begin + MessageDlg('Group variable is not specified.', mtError, [mbOk], 0); + exit; + end; + + if (MeasEdit.Text = '') then + begin + MessageDlg('Measurement variable is not specified.', mtError, [mbOK], 0); + exit; + end; + + GrpVar := 1; + MeasVar := 2; + Sigma := 3.0; + UpperSpec := 0.0; + LowerSpec := 0.0; + TargetSpec := 0.0; + grpsize := 0; + oldgrpsize := 0; + + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = GroupEdit.Text then GrpVar := i; + if cellstring = MeasEdit.Text then MeasVar := i; + end; + + mingrp := 10000; + maxgrp := -10000; + for i := 1 to NoCases do + begin + G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); + if G < mingrp then mingrp := G; + if G > maxgrp then maxgrp := G; + end; + range := maxgrp - mingrp + 1; + + SetLength(means, range); + SetLength(count, range); + SetLength(stddev, range); + + for i := 0 to range-1 do + begin + count[i] := 0; + means[i] := 0.0; + stddev[i] := 0.0; + end; + semean := 0.0; + GrandMean := 0.0; + GrandSigma := 0.0; + sizeerror := false; + + // calculate group ranges, grand mean, group sd's, semeans + for j := 1 to range do // groups + begin + xmin := 10000.0; + xmax := -10000.0; + for i := 1 to NoCases do + begin + G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); + G := G - mingrp + 1; + if G = j then + begin + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar,i])); + if X > xmax then xmax := X; + if X < xmin then xmin := X; + means[G-1] := means[G-1] + X; + count[G-1] := count[G-1] + 1; + stddev[G-1] := stddev[G-1] + (X * X); + semean := semean + (X * X); + GrandMean := GrandMean + X; + end; + end; // next case + stddev[j-1] := stddev[j-1] - (means[j-1] * means[j-1] / count[j-1]); + stddev[j-1] := stddev[j-1] / (count[j-1] - 1); + stddev[j-1] := sqrt(stddev[j-1]); + means[j-1] := means[j-1] / count[j-1]; + GrandSigma := GrandSigma + stddev[j-1]; + grpsize := count[j-1]; + if j = 1 then oldgrpsize := grpsize; + if oldgrpsize <> grpsize then sizeerror := true; + end; + + if (grpsize < 2) or (grpsize > 25) or (sizeerror) then + begin + MessageDlg('Group sizes error.', mtError, [mbOK], 0); + CleanUp; + exit; + end; + + semean := semean - ((GrandMean * GrandMean) / NoCases); + semean := semean / (NoCases - 1); + semean := sqrt(semean); + GrandSD := semean; + semean := semean / sqrt(NoCases); + GrandMean := GrandMean / NoCases; + GrandSigma := GrandSigma / range; + D3Value := D3[grpsize-1]; + D4Value := D4[grpsize-1]; + C4 := sqrt(2.0 / (grpsize - 1)); + gamma := exp(gammln(grpsize / 2.0)); + C4 := C4 * gamma; + gamma := exp(gammln((grpsize-1) / 2.0)); + C4 := C4 / gamma; + B := GrandSigma * sqrt(1.0 - (C4 * C4)) / C4; + UCL := GrandSigma + 3.0 * B; + LCL := GrandSigma - 3.0 * B; + if (LCL < 0.0) then LCL := 0.0; + + // printed results + lReport := TStringList.Create; + try + lReport.Add('Sigma Chart Results'); + lReport.Add(''); + lReport.Add('Group Size Mean Std.Dev.'); + lReport.Add('_____ ____ _________ ________'); + for i := 0 to range-1 do + lReport.Add(' %3d %3d %8.2f %8.2f', [i+1, count[i], means[i], stddev[i]]); + lReport.Add(''); + lReport.Add('Grand Mean: %8.3f', [GrandMean]); + lReport.Add('Standard Deviation: %8.3f', [GrandSD]); + lReport.Add('Standard Error of Mean: %8.3f', [semean]); + lReport.Add('Mean Sigma: %8.3f', [GrandSigma]); + lReport.Add('Lower Control Limit: %8.3f', [LCL]); + lReport.Add('Upper Control Limit: %8.3f', [UCL]); + + DisplayReport(lReport); + finally + lReport.Free; + end; + + // show graph + PlotMeans(stddev, range, UCL, LCL, GrandSigma, TargetSpec, LowerSpec, UpperSpec); + + // clean up + CleanUp; +end; + +procedure TSigmaChartFrm.PlotMeans(var means: DblDyneVec; NoGrps: integer; + UCL, LCL, GrandMean: double; TargetSpec, LowerSpec, UpperSpec: double); +var + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; + vhi, hwide, offset, strhi : integer; + imagehi, maxval, minval, valincr, Yvalue : double; + Title : string; +begin + maxval := -10000.0; + minval := 10000.0; + for i := 0 to NoGrps-1 do + begin + if means[i] > maxval then maxval := means[i]; + if means[i] < minval then minval := means[i]; + end; + if UCL > maxval then maxval := UCL; + if LCL < minval then minval := LCL; + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Show; + Title := 'SIGMA CHART FOR : ' + OS3MainFrm.FileNameEdit.Text; + BlankFrm.Caption := Title; + imagewide := BlankFrm.Width; + imagehi := BlankFrm.Height; + vtop := 20; + vbottom := round(imagehi) - 80; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + + BlankFrm.Image1.Canvas.Brush.Color := clLtGray; + BlankFrm.Image1.Canvas.FillRect(0, 0, BlankFrm.Image1.Width, BlankFrm.Image1.Height); + + // Draw chart border + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Rectangle(hleft,vtop-10,hleft+hwide,vtop+vhi+10); + + // draw Grand Mean + ypos := round(vhi * ( (maxval - GrandMean) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'MEAN'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.Brush.Style := bsClear; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + // draw horizontal axis + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 20); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom + 20); + for i := 1 to NoGrps do + begin + ypos := vbottom + 10; + xpos := round((hwide / NoGrps)* i + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := format('%d',[i]); + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := xpos - offset; + ypos := ypos + strhi; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + xpos := 10; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:'); + end; + + // Draw vertical axis + valincr := (maxval - minval) / 10.0; + for i := 1 to 11 do + begin + Title := format('%8.2f',[maxval - ((i-1)*valincr)]); + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := 10; + Yvalue := maxval - (valincr * (i-1)); + ypos := round(vhi * ( (maxval - Yvalue) / (maxval - minval))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + + // draw lines for means of the groups + ypos := round(vhi * ( (maxval - means[0]) / (maxval - minval))); + ypos := ypos + vtop; + xpos := round((hwide / NoGrps) + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + for i := 2 to NoGrps do + begin + ypos := round(vhi * ( (maxval - means[i-1]) / (maxval - minval))); + ypos := ypos + vtop; + xpos := round((hwide / NoGrps)* i + hleft); + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // Draw upper and lower confidence intervals + ypos := round(vhi * ( (maxval - UCL) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'UCL'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + ypos := round(vhi * ( (maxval - LCL) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'LCL'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); +end; + +initialization + {$I sigmachartunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/uchartunit.lfm b/applications/lazstats/source/forms/analysis/statistical_process_control/uchartunit.lfm new file mode 100644 index 000000000..4c86bac5d --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/uchartunit.lfm @@ -0,0 +1,277 @@ +object UChartFrm: TUChartFrm + Left = 641 + Height = 339 + Top = 233 + Width = 425 + AutoSize = True + Caption = 'Defects per unit U Chart' + ClientHeight = 339 + ClientWidth = 425 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Selection Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = MeasEdit + AnchorSideTop.Control = Owner + Left = 187 + Height = 15 + Top = 8 + Width = 117 + BorderSpacing.Top = 8 + Caption = 'Measurement Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = NoInspEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NoInspEdit + Left = 215 + Height = 15 + Top = 72 + Width = 131 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'No. inspected per group:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = SigmaOpts + AnchorSideBottom.Control = Bevel2 + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 264 + Top = 26 + Width = 171 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Constraints.MinHeight = 220 + ItemHeight = 0 + OnClick = VarListClick + TabOrder = 0 + end + object MeasEdit: TEdit + AnchorSideLeft.Control = VarList + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 187 + Height = 23 + Top = 25 + Width = 230 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 1 + Text = 'MeasEdit' + end + object NoInspEdit: TEdit + AnchorSideTop.Control = MeasEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 354 + Height = 23 + Top = 68 + Width = 63 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 20 + BorderSpacing.Right = 8 + TabOrder = 2 + Text = 'NoInspEdit' + end + object SigmaOpts: TRadioGroup + AnchorSideTop.Control = NoInspEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 187 + Height = 120 + Top = 111 + Width = 230 + Anchors = [akTop, akRight] + AutoFill = False + AutoSize = True + BorderSpacing.Top = 20 + BorderSpacing.Right = 8 + Caption = 'No. of Sigma Units for UCL and LCL' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 4 + ClientHeight = 100 + ClientWidth = 226 + ItemIndex = 0 + Items.Strings = ( + '3 Sigma (Default)' + '2 Sigma' + '1 Sigma' + 'X Sigma where X = ' + ) + TabOrder = 3 + object Label4: TLabel + Left = 134 + Height = 19 + Top = 6 + Width = 80 + Caption = ' ' + ParentColor = False + end + object Label5: TLabel + Left = 134 + Height = 19 + Top = 27 + Width = 80 + Caption = ' ' + ParentColor = False + end + object Label6: TLabel + Left = 134 + Height = 19 + Top = 48 + Width = 80 + Caption = ' ' + ParentColor = False + end + object XSigmaEdit: TEdit + AnchorSideRight.Control = SigmaOpts + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 134 + Height = 23 + Top = 69 + Width = 80 + Alignment = taRightJustify + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + TabOrder = 2 + Text = 'XSigmaEdit' + end + end + object Panel1: TPanel + Left = 0 + Height = 41 + Top = 298 + Width = 425 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + ClientHeight = 41 + ClientWidth = 425 + TabOrder = 4 + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ComputeBtn + Left = 216 + Height = 25 + Top = 8 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = CloseBtn + Left = 278 + Height = 25 + Top = 8 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object HelpBtn: TButton + Tag = 141 + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ResetBtn + Left = 157 + Height = 25 + Top = 8 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 0 + end + object CloseBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 362 + Height = 25 + Top = 8 + Width = 55 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 3 + end + end + object Bevel2: TBevel + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + Left = 0 + Height = 8 + Top = 290 + Width = 425 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Bevel1: TBevel + Left = 8 + Height = 29 + Top = 308 + Width = 42 + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/uchartunit.pas b/applications/lazstats/source/forms/analysis/statistical_process_control/uchartunit.pas new file mode 100644 index 000000000..cedf96efc --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/uchartunit.pas @@ -0,0 +1,393 @@ +// File for testing: "defects.laz" +// - Measurement variable: "Defects" +// - No. inspected per group: 1000 + +unit UChartUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, + MainUnit, Globals, OutputUnit, DataProcs, BlankFrmUnit, ContextHelpUnit; + +type + + { TUChartFrm } + + TUChartFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + ComputeBtn: TButton; + HelpBtn: TButton; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Panel1: TPanel; + ResetBtn: TButton; + CloseBtn: TButton; + XSigmaEdit: TEdit; + NoInspEdit: TEdit; + Label3: TLabel; + MeasEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + SigmaOpts: TRadioGroup; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure PlotMeans(var Means: DblDyneVec; NoGrps: integer; + UCL, LCL, GrandMean: double); + function Validate(out AMsg: String; out AControl: TWinControl): boolean; + public + { public declarations } + end; + +var + UChartFrm: TUChartFrm; + +implementation + +uses + Math; + +{ TUChartFrm } + +procedure TUChartFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + MeasEdit.Text := ''; + NoInspEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TUChartFrm.VarListClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if index > -1 then + begin + MeasEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; +end; + +procedure TUChartFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinWidth := SigmaOpts.Width * 3 div 4; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TUChartFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if BlankFrm = nil then + Application.CreateForm(TBlankFrm, BlankFrm); +end; + +procedure TUChartFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TUChartFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TUChartFrm.ComputeBtnClick(Sender: TObject); +var + i, MeasVar: integer; + X, size, count, UCL, LCL, Sigma: double; + GrandMean, meanc, stddevc: double; + means, defperunit: DblDyneVec; + cellstring: string; + ColNoSelected: IntDyneVec; + NoSelected: integer; + msg: String; + C: TWinControl; + lReport: TStrings; +begin + if not Validate(msg, C) then + begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + exit; + end; + + SetLength(ColNoSelected,2); + MeasVar := 0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = MeasEdit.Text then MeasVar := i; + end; + NoSelected := 1; + ColNoSelected[0] := MeasVar; + + case SigmaOpts.ItemIndex of + 0: Sigma := 3.0; + 1: Sigma := 2.0; + 2: Sigma := 1.0; + 3: Sigma := StrToFloat(XSigmaEdit.Text); + end; + + SetLength(means, NoCases + 1); + SetLength(defperunit, NoCases + 1); + GrandMean := 0.0; + size := 0.0; + count := StrToFloat(NoInspEdit.Text); + + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar,i])); + means[i] := X; + GrandMean := GrandMean + X; + defperunit[i] := means[i] / count; + size := size + count; + end; + + meanc := GrandMean / size; + stddevc := sqrt(meanc / count); + UCL := meanc + Sigma * stddevc; + LCL := meanc - Sigma * stddevc; + + // printed results + lReport := TStringList.Create; + try + lReport.Add('DEFECTS c CONTROL CHART RESULTS'); + lReport.Add(''); + lReport.Add('Sample No Defects Defects Per Unit'); + lReport.Add('------ ---------- ----------------'); + for i := 1 to NoCases do + lReport.Add(' %3d %8.2f %8.2f', [i, means[i], defperunit[i]]); + lReport.Add(''); + lReport.Add('Total Nonconformities: %8.2f', [GrandMean]); + lReport.Add('No. of Samples: %8d', [NoCases]); + lReport.Add('Def. / unit Mean: %8.3f', [meanc]); + lReport.Add(' and StdDev: %8.3f', [stddevc]); + lReport.Add('Lower Control Limit: %8.3f', [LCL]); + lReport.Add('Upper Control Limit: %8.3f', [UCL]); + DisplayReport(lReport); + finally + lReport.Free; + end; + + // show graph + PlotMeans(defperunit, NoCases, UCL, LCL, meanc); + + defperunit := nil; + means := nil; + ColNoSelected := nil; +end; + +procedure TUChartFrm.PlotMeans(var Means: DblDyneVec; NoGrps: integer; + UCL, LCL, GrandMean: double); +var + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; + vhi, hwide, offset, strhi : integer; + imagehi, maxval, minval, valincr, Yvalue : double; + Title : string; +begin + maxval := -10000.0; + minval := 10000.0; + for i := 1 to NoGrps do + begin + if means[i] > maxval then maxval := means[i]; + if means[i] < minval then minval := means[i]; + end; + if UCL > maxval then maxval := UCL; + if LCL < minval then minval := LCL; + BlankFrm.Show; + Title := 'DEFECT CONTROL (c) CHART FOR : ' + OS3MainFrm.FileNameEdit.Text; + BlankFrm.Caption := Title; + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + vtop := 20; + vbottom := round(imagehi) - 80; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 80; + hwide := hright - hleft; + + BlankFrm.Image1.Canvas.Brush.Color := clLtGray; + BlankFrm.Image1.Canvas.FillRect(0, 0, BlankFrm.Image1.Width, BlankFrm.Image1.Height); + + // Draw chart border + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Rectangle(hleft,vtop-10,hleft+hwide,vtop+vhi+10); + + // draw Grand Mean + ypos := round(vhi * ( (maxval - GrandMean) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.Brush.Style := bsClear; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'MEAN'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + // draw horizontal axis + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom + 20); + BlankFrm.Image1.Canvas.LineTo(hright,vbottom + 20); + for i := 1 to NoGrps do + begin + ypos := vbottom + 10; + xpos := round((hwide / NoGrps)* i + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + ypos := ypos + 10; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := format('%d',[i]); + offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := xpos - offset; + ypos := ypos + strhi; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + xpos := 10; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,'GROUPS:'); + end; + + // Draw vertical axis + valincr := (maxval - minval) / 10.0; + for i := 1 to 11 do + begin + Title := format('%8.3f',[maxval - ((i-1)*valincr)]); + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + xpos := 10; + Yvalue := maxval - (valincr * (i-1)); + ypos := round(vhi * ( (maxval - Yvalue) / (maxval - minval))); + ypos := ypos + vtop - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + end; + + // draw lines for means of the groups + ypos := round(vhi * ( (maxval - means[1]) / (maxval - minval))); + ypos := ypos + vtop; + xpos := round((hwide / NoGrps) + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + for i := 2 to NoGrps do + begin + ypos := round(vhi * ( (maxval - means[i]) / (maxval - minval))); + ypos := ypos + vtop; + xpos := round((hwide / NoGrps)* i + hleft); + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + end; + + // Draw upper and lower confidence intervals + ypos := round(vhi * ( (maxval - UCL) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'UCL'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); + + ypos := round(vhi * ( (maxval - LCL) / (maxval - minval))); + ypos := ypos + vtop; + xpos := hleft; + BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); + xpos := hright; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.LineTo(xpos,ypos); + Title := 'LCL'; + strhi := BlankFrm.Image1.Canvas.TextHeight(Title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); +end; + +function TUChartFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + n: Integer; + x: Double; +begin + Result := false; + + if MeasEdit.Text = '' then + begin + AMsg := 'Measurement variable is not specified.'; + AControl := MeasEdit; + exit; + end; + + if NoInspEdit.Text = '' then + begin + AMsg := 'Number inspected per group is not specified.'; + AControl := NoInspEdit; + exit; + end; + if not TryStrToInt(NoInspEdit.Text, n) then + begin + AMsg := 'Number inspected per group is not a valid number.'; + AControl := NoInspEdit; + exit; + end; + + if SigmaOpts.ItemIndex = 3 then + begin + if XSigmaEdit.Text = '' then + begin + AMsg := 'X sigma is not specified.'; + AControl := XSigmaEdit; + exit; + end; + if not TryStrToFloat(XSigmaEdit.Text, x) then + begin + AMsg := 'X sigma is not a valid number.'; + AControl := XSigmaEdit; + exit; + end; + end; + + Result := true; +end; +initialization + {$I uchartunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/xbarunit.lfm b/applications/lazstats/source/forms/analysis/statistical_process_control/xbarunit.lfm new file mode 100644 index 000000000..0f6ef31de --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/xbarunit.lfm @@ -0,0 +1,353 @@ +object XBarFrm: TXBarFrm + Left = 591 + Height = 397 + Top = 279 + Width = 499 + AutoSize = True + Caption = 'X Bar Charting Specifications' + ClientHeight = 397 + ClientWidth = 499 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 97 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Selection Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = SigmaOpts + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 323 + Top = 25 + Width = 227 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ItemHeight = 0 + OnClick = VarListClick + TabOrder = 0 + end + object SigmaOpts: TRadioGroup + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 243 + Height = 128 + Top = 108 + Width = 248 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + Caption = 'No. of Sigma Units for UCL and LCL:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 108 + ClientWidth = 244 + ItemIndex = 0 + Items.Strings = ( + '3 Sigma (default)' + '2 Sigma' + '1 Sigma' + 'X Sigmas where X = ' + ) + TabOrder = 2 + object XSigmaEdit: TEdit + AnchorSideRight.Control = SigmaOpts + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox1 + AnchorSideBottom.Side = asrBottom + Left = 152 + Height = 23 + Top = 80 + Width = 80 + Alignment = taRightJustify + Anchors = [akRight, akBottom] + TabOrder = 2 + Text = 'XSigmaEdit' + end + end + object GroupBox1: TGroupBox + AnchorSideTop.Control = SigmaOpts + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 243 + Height = 101 + Top = 248 + Width = 248 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + Caption = 'Options' + ClientHeight = 81 + ClientWidth = 244 + TabOrder = 3 + object UpSpecChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = UpSpecEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 19 + Top = 2 + Width = 148 + BorderSpacing.Left = 12 + Caption = 'Show Upper Spec. Level:' + TabOrder = 0 + end + object LowSpecChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = LowSpecEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 19 + Top = 29 + Width = 145 + BorderSpacing.Left = 12 + Caption = 'Show Lower Spec. Level' + TabOrder = 2 + end + object TargetChk: TCheckBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = TargetSpecEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 19 + Top = 56 + Width = 146 + BorderSpacing.Left = 12 + BorderSpacing.Bottom = 6 + Caption = 'Use Target Specification' + TabOrder = 4 + end + object UpSpecEdit: TEdit + AnchorSideLeft.Control = UpSpecChk + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox1 + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 172 + Height = 23 + Top = 0 + Width = 64 + Alignment = taRightJustify + BorderSpacing.Left = 12 + BorderSpacing.Right = 8 + TabOrder = 1 + Text = 'UpSpecEdit' + end + object LowSpecEdit: TEdit + AnchorSideLeft.Control = UpSpecEdit + AnchorSideTop.Control = UpSpecEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = UpSpecEdit + AnchorSideRight.Side = asrBottom + Left = 172 + Height = 23 + Top = 27 + Width = 64 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 3 + Text = 'Edit1' + end + object TargetSpecEdit: TEdit + AnchorSideLeft.Control = UpSpecEdit + AnchorSideTop.Control = LowSpecEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = UpSpecEdit + AnchorSideRight.Side = asrBottom + Left = 172 + Height = 23 + Top = 54 + Width = 64 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 5 + Text = 'Edit1' + end + end + object ResetBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 290 + Height = 25 + Top = 364 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object ComputeBtn: TButton + AnchorSideRight.Control = CloseBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 352 + Height = 25 + Top = 364 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end + object CloseBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 436 + Height = 25 + Top = 364 + Width = 55 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Close' + ModalResult = 11 + TabOrder = 7 + end + object HelpBtn: TButton + Tag = 159 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 231 + Height = 25 + Top = 364 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 4 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CloseBtn + Left = 0 + Height = 8 + Top = 348 + Width = 499 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = Owner + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 243 + Height = 88 + Top = 8 + Width = 248 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BevelOuter = bvNone + ClientHeight = 88 + ClientWidth = 248 + TabOrder = 1 + object Label2: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 15 + Top = 0 + Width = 105 + BorderSpacing.Bottom = 2 + Caption = 'Group (Lot) Variable' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = GroupEdit + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 15 + Top = 48 + Width = 117 + BorderSpacing.Bottom = 2 + Caption = 'Measurement Variable' + ParentColor = False + end + object GroupEdit: TEdit + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 23 + Top = 17 + Width = 248 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 8 + ReadOnly = True + TabOrder = 0 + Text = 'GroupEdit' + end + object MeasEdit: TEdit + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 23 + Top = 65 + Width = 248 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + ReadOnly = True + TabOrder = 1 + Text = 'MeasEdit' + end + end +end diff --git a/applications/lazstats/source/forms/analysis/statistical_process_control/xbarunit.pas b/applications/lazstats/source/forms/analysis/statistical_process_control/xbarunit.pas new file mode 100644 index 000000000..2877d91d3 --- /dev/null +++ b/applications/lazstats/source/forms/analysis/statistical_process_control/xbarunit.pas @@ -0,0 +1,535 @@ +// Use file "boltsize.laz" for testing +// Group Variable --> LotNo +// Selected Variable --> BoltLength +// Upper Spec Level --> 20.05 +// Lower Spec Level --> 19.95 +// Target Spec --> 20.00 + +unit XBarUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, + MainUnit, Globals, ContextHelpUnit, DataProcs, OutputUnit, GraphLib, BlankFrmUnit; + +type + + { TXBarFrm } + + TXBarFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + CloseBtn: TButton; + UpSpecEdit: TEdit; + LowSpecEdit: TEdit; + TargetSpecEdit: TEdit; + UpSpecChk: TCheckBox; + LowSpecChk: TCheckBox; + TargetChk: TCheckBox; + GroupBox1: TGroupBox; + XSigmaEdit: TEdit; + GroupEdit: TEdit; + MeasEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + SigmaOpts: TRadioGroup; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure VarListClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + procedure PlotMeans(var Means: DblDyneVec; NoGrps: integer; + UCL, LCL, GrandMean, TargetSpec, LowerSpec, UpperSpec: double); + function Validate(out AMsg: String; out AControl: TWinControl): Boolean; + public + { public declarations } + end; + +var + XBarFrm: TXBarFrm; + +implementation + +uses + Math; + +{ TXBarFrm } + +procedure TXBarFrm.ResetBtnClick(Sender: TObject); +var + i : integer; +begin + VarList.Clear; + GroupEdit.Text := ''; + MeasEdit.Text := ''; + UpSpecEdit.Text := ''; + LowSpecEdit.Text := ''; + TargetSpecEdit.Text := ''; + UpSpecChk.Checked := false; + LowSpecChk.Checked := false; + TargetChk.Checked := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TXBarFrm.VarListClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if index > -1 then + begin + if GroupEdit.Text = '' then + GroupEdit.Text := VarList.Items[index] + else + MeasEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + end; +end; + +procedure TXBarFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TXBarFrm.ComputeBtnClick(Sender: TObject); +var + i, GrpVar, MeasVar, mingrp, maxgrp, G, range: integer; + X, UCL, LCL, Sigma, UpperSpec, LowerSpec, TargetSpec: double; + GrandMean, GrandSD, semean: double; + means, stddev: DblDyneVec; + count: IntDyneVec; + cellstring: string; + ColNoSelected: IntDyneVec; + NoSelected: integer; + msg: String; + C: TWinControl; + lReport: TStrings; +begin + if not Validate(msg, C) then begin + C.SetFocus; + MessageDlg(msg, mtError, [mbOK], 0); + exit; + end; + + SetLength(ColNoSelected, NoVariables); + + GrpVar := 1; + MeasVar := 2; + Sigma := 3.0; + UpperSpec := 0.0; + LowerSpec := 0.0; + TargetSpec := 0.0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = GroupEdit.Text then GrpVar := i; + if cellstring = MeasEdit.Text then MeasVar := i; + end; + ColNoSelected[0] := MeasVar; + ColNoSelected[1] := GrpVar; + NoSelected := 2; + + if UpSpecEdit.Text <> '' then UpperSpec := StrToFloat(UpSpecEdit.Text); + if LowSpecEdit.Text <> '' then LowerSpec := StrToFloat(LowSpecEdit.Text); + if TargetSpecEdit.Text <> '' then TargetSpec := StrToFloat(TargetSpecEdit.Text); + + case SigmaOpts.ItemIndex of + 0: Sigma := 3.0; + 1: Sigma := 2.0; + 2: Sigma := 1.0; + 3: Sigma := StrToFloat(XSigmaEdit.Text); + end; + + mingrp := 10000; + maxgrp := -10000; + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); + if G < mingrp then mingrp := G; + if G > maxgrp then maxgrp := G; + end; + range := maxgrp - mingrp + 1; + + SetLength(means, range); + SetLength(count, range); + SetLength(stddev, range); + for i := 0 to range-1 do + begin + count[i] := 0; + means[i] := 0.0; + stddev[i] := 0.0; + end; + semean := 0.0; + GrandMean := 0.0; + + // calculate group means, grand mean, group sd's, semeans + for i := 1 to NoCases do + begin + if not GoodRecord(i,NoSelected,ColNoSelected) then continue; + G := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GrpVar,i]))); + G := G - mingrp + 1; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[MeasVar,i])); + means[G-1] := means[G-1] + X; + count[G-1] := count[G-1] + 1; + stddev[G-1] := stddev[G-1] + (X * X); + semean := semean + (X * X); + GrandMean := GrandMean + X; + end; + + for i := 0 to range-1 do + begin + stddev[i] := stddev[i] - sqr(means[i]) / count[i]; + if count[i] > 1 then + begin + stddev[i] := stddev[i] / (count[i] - 1); + stddev[i] := sqrt(stddev[i]); + end + else + stddev[i] := 0.0; + means[i] := means[i] / count[i]; + end; + semean := semean - sqr(GrandMean) / NoCases; + semean := sqrt(semean / (NoCases - 1)); + GrandSD := semean; + semean := semean / sqrt(NoCases); + GrandMean := GrandMean / NoCases; + UCL := GrandMean + Sigma * semean; + LCL := GrandMean - Sigma * semean; + + // printed results + lReport := TStringList.Create; + try + lReport.Add('X BAR CHART RESULTS'); + lReport.Add(''); + lReport.Add('Group Size Mean Std.Dev.'); + lReport.Add('----- ---- --------- ----------'); + for i := 0 to range-1 do + lReport.Add(' %3d %3d %8.2f %8.2f', [i+1, count[i], means[i], stddev[i]]); + lReport.Add(''); + lReport.Add('Grand Mean: %8.3f', [GrandMean]); + lReport.Add('Standard Deviation: %8.3f', [GrandSD]); + lReport.Add('Standard Error of Mean: %8.3f', [semean]); + lReport.Add(''); + lReport.Add('Lower Control Limit: %8.3f', [LCL]); + lReport.Add('Upper Control Limit: %8.3f', [UCL]); + + DisplayReport(lReport); + finally + lReport.Free; + end; + + // show graph + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Show; + PlotMeans(means, range, UCL, LCL, GrandMean, TargetSpec, LowerSpec, UpperSpec); + + // Clean up + stddev := nil; + count := nil; + means := nil; + ColNoSelected := nil; +end; + +procedure TXBarFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; + + VarList.Constraints.MinWidth := GroupBox1.Width; + VarList.Constraints.MinHeight := GroupBox1.Top + GroupBox1.Height - VarList.Top; + + AutoSize := false; +// ClientHeight := GroupBox1.Top + GroupBox1.Height + Panel1.BorderSpacing.Top + Panel1.Height + Bevel1.Height + CloseBtn.Height + CloseBtn.BorderSpacing.Top*2; + Constraints.MinHeight := Height; + Constraints.MinWidth := Width; + + FAutoSized := true; +end; + +procedure TXBarFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if BlankFrm = nil then + Application.CreateForm(TBlankFrm, BlankFrm); +end; + +procedure TXBarFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TXBarFrm.PlotMeans(var means: DblDyneVec; NoGrps: integer; + UCL, LCL, GrandMean: double; TargetSpec, LowerSpec, UpperSpec: double); +var + i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide: integer; + vhi, hwide, offset, strhi: integer; + imagehi, maxval, minval, valincr, Yvalue: double; + title: String; +begin + maxval := -10000.0; + minval := 10000.0; + for i := 0 to NoGrps-1 do + begin + if means[i] > maxval then maxval := means[i]; + if means[i] < minval then minval := means[i]; + end; + if UCL > maxval then maxval := UCL; + if LCL < minval then minval := LCL; + if UpSpecChk.Checked and (UpperSpec > maxval) then maxval := UpperSpec; + if LowSpecChk.Checked and (LowerSpec < minval) then minval := LowerSpec; + if TargetChk.Checked then + begin + if TargetSpec > maxval then maxval := TargetSpec; + if TargetSpec < minval then minval := TargetSpec; + end; + + BlankFrm.Caption := 'XBAR CHART FOR ' + OS3MainFrm.FileNameEdit.Text; + imagewide := BlankFrm.Image1.Width; + imagehi := BlankFrm.Image1.Height; + vtop := 20; + vbottom := round(imagehi) - 80; + vhi := vbottom - vtop; + hleft := 100; + hright := imagewide - 100; + hwide := hright - hleft; + + // Draw outer background + BlankFrm.Image1.Canvas.Brush.Color := clLtGray; + BlankFrm.Image1.Canvas.FillRect(0, 0, BlankFrm.Image1.Width, BlankFrm.Image1.Height); + + // Draw chart border and inner background + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Rectangle(hleft,vtop-10,hleft+hwide,vtop+vhi+10); + + // Draw Grand Mean + xpos := hright + 10; + ypos := round(vhi * ( (maxval - GrandMean) / (maxval - minval))); + ypos := ypos + vtop; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.Line(hLeft, ypos, hright, ypos); + title := 'MEAN'; + strhi := BlankFrm.Image1.Canvas.TextHeight(title); + BlankFrm.Image1.Canvas.Brush.Style := bsClear; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos - strhi div 2, title); + + // draw horizontal axis + //BlankFrm.Image1.Canvas.Line(hleft, vbottom + 20, hright, vbottom + 20); + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + for i := 1 to NoGrps do + begin + ypos := vbottom + 10; + xpos := round(hwide / NoGrps * i + hleft); + BlankFrm.Image1.Canvas.Line(xpos, ypos, xpos, ypos + 10); + title := Format('%d', [i]); + offset := BlankFrm.Image1.Canvas.TextWidth(title) div 2; + strhi := BlankFrm.Image1.Canvas.TextHeight(title); + xpos := xpos - offset; + ypos := ypos + strhi; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, title); + xpos := 10; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, 'GROUPS'); + end; + + // Draw vertical axis + valincr := (maxval - minval) / 10.0; + for i := 1 to 11 do + begin + title := Format('%.2f', [maxval - (i - 1) * valincr]); + strhi := BlankFrm.Image1.Canvas.TextHeight(title); + Yvalue := maxval - valincr * (i - 1); + ypos := vtop + round(vhi * (maxval - Yvalue) / (maxval - minval)); + BlankFrm.Image1.Canvas.Line(hleft, ypos, hleft-10, ypos); + xpos := hleft - 20 - BlankFrm.Image1.Canvas.TextWidth(title);; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos - strhi div 2, title); + end; + + // draw lines for means of the groups + ypos := round(vhi * (maxval - means[0]) / (maxval - minval)); + ypos := ypos + vtop; + xpos := round(hwide/NoGrps + hleft); + BlankFrm.Image1.Canvas.MoveTo(xpos, ypos); + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + for i := 2 to NoGrps do + begin + ypos := round(vhi * (maxval - means[i-1]) / (maxval - minval)); + ypos := ypos + vtop; + xpos := round(hwide/NoGrps* i + hleft); + BlankFrm.Image1.Canvas.LineTo(xpos, ypos); + end; + + // Draw upper and lower confidence intervals + xpos := hright + 10; + ypos := round(vhi * (maxval - UCL) / (maxval - minval)); + ypos := ypos + vtop; + BlankFrm.Image1.Canvas.Pen.Style := psDash; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.Line(hleft, ypos, hright, ypos); + title := 'UCL'; + strhi := BlankFrm.Image1.Canvas.TextHeight(title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, title); + + ypos := round(vhi * ( (maxval - LCL) / (maxval - minval))); + ypos := ypos + vtop; + BlankFrm.Image1.Canvas.Pen.Color := clRed; + BlankFrm.Image1.Canvas.Line(hleft, ypos, hright, ypos); + title := 'LCL'; + strhi := BlankFrm.Image1.Canvas.TextHeight(title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, title); + + // Draw lines for specified values + BlankFrm.Image1.Canvas.Pen.Color := clGreen; + if UpSpecChk.Checked then + begin + ypos := round(vhi * (maxval - UpperSpec) / (maxval - minval)); + ypos := ypos + vtop; + BlankFrm.Image1.Canvas.Pen.Style := psSolid; + BlankFrm.Image1.Canvas.Line(hleft, ypos, hright, ypos); + title := 'UPPER SPEC'; + strhi := BlankFrm.Image1.Canvas.TextHeight(title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, title); + end; + if LowSpecChk.Checked then + begin + ypos := round(vhi * (maxval - LowerSpec) / (maxval - minval)); + ypos := ypos + vtop; + BlankFrm.Image1.Canvas.Pen.Color := clGreen; + BlankFrm.Image1.Canvas.Line(hleft, ypos, hright, ypos); + title := 'LOWER SPEC'; + strhi := BlankFrm.Image1.Canvas.TextHeight(title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, title); + end; + if TargetChk.Checked then + begin + ypos := round(vhi * (maxval - TargetSpec) / (maxval - minval)); + ypos := ypos + vtop; + BlankFrm.Image1.Canvas.Pen.Color := clBlue; + BlankFrm.Image1.Canvas.Line(hleft, ypos, hright, ypos); + title := 'TARGET'; + strhi := BlankFrm.Image1.Canvas.TextHeight(title); + ypos := ypos - strhi div 2; + BlankFrm.Image1.Canvas.TextOut(xpos, ypos, title); + end; +end; + +function TXBarFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +var + x: Double; +begin + Result := false; + if GroupEdit.Text = '' then begin + AMsg := 'Group variable not specified.'; + AControl := GroupEdit; + exit; + end; + if MeasEdit.Text = '' then + begin + AMsg := 'Measurement variable not specified.'; + AControl := MeasEdit; + exit; + end; + if SigmaOpts.ItemIndex = -1 then + begin + AMsg := 'Number of sigma units for UCL and LCL not specified.'; + AControl := SigmaOpts; + exit; + end; + if SigmaOpts.ItemIndex = 3 then + begin + if (XSigmaEdit.Text = '') then + begin + AMsg := 'User-defined sigma units missing.'; + AControl := XSigmaEdit; + exit; + end; + if not TryStrToFloat(XSigmaEdit.Text, x) then + begin + AMsg := 'No valid number given for sser-defined sigma units.'; + AControl := XSigmaEdit; + exit; + end; + end; + + if UpSpecChk.Checked then begin + if UpSpecEdit.Text = '' then + begin + AMsg := 'Upper Spec Level missing.'; + AControl := UpSpecEdit; + exit; + end; + if not TryStrToFloat(UpSpecEdit.Text, x) then + begin + AMsg := 'Upper Spec Level is not a valid number.'; + AControl := UpSpecEdit; + exit; + end; + end; + + if LowSpecChk.Checked then begin + if LowSpecEdit.Text = '' then + begin + AMsg := 'Lower Spec Level missing.'; + AControl := LowSpecEdit; + exit; + end; + if not TryStrToFloat(LowSpecEdit.Text, x) then + begin + AMsg := 'Lower Spec Level is not a valid number.'; + AControl := LowSpecEdit; + exit; + end; + end; + + if TargetChk.Checked then begin + if TargetSpecEdit.Text = '' then + begin + AMsg := 'Target Spec Level missing.'; + AControl := TargetSpecEdit; + exit; + end; + if not TryStrToFloat(TargetSpecEdit.Text, x) then + begin + AMsg := 'Target Spec Level is not a valid number.'; + AControl := TargetSpecEdit; + exit; + end; + end; + + Result := true; +end; + +initialization + {$I xbarunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/help/aboutunit.lfm b/applications/lazstats/source/forms/help/aboutunit.lfm new file mode 100644 index 000000000..0fd41818d --- /dev/null +++ b/applications/lazstats/source/forms/help/aboutunit.lfm @@ -0,0 +1,105 @@ +object AboutBox: TAboutBox + Left = 202 + Height = 170 + Top = 145 + Width = 295 + AutoSize = True + BorderStyle = bsDialog + Caption = 'About LazStats' + ClientHeight = 170 + ClientWidth = 295 + Color = clBtnFace + Font.Color = clWindowText + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object OKButton: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + Left = 111 + Height = 25 + Top = 134 + Width = 75 + BorderSpacing.Bottom = 8 + Caption = 'OK' + Default = True + ModalResult = 1 + TabOrder = 0 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + Left = 8 + Height = 118 + Top = 8 + Width = 280 + AutoSize = True + BorderSpacing.Around = 8 + BevelInner = bvRaised + BevelOuter = bvLowered + ClientHeight = 118 + ClientWidth = 280 + Constraints.MinWidth = 280 + TabOrder = 1 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel1 + Left = 95 + Height = 32 + Top = 10 + Width = 91 + BorderSpacing.Top = 8 + Caption = 'LazStats' + Font.CharSet = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -24 + Font.Pitch = fpVariable + Font.Quality = fqDraft + Font.Style = [fsBold] + ParentColor = False + ParentFont = False + end + object Label2: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + Left = 83 + Height = 21 + Top = 50 + Width = 115 + BorderSpacing.Top = 8 + Caption = 'William G. Miller' + Font.CharSet = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Pitch = fpVariable + Font.Quality = fqDraft + ParentColor = False + ParentFont = False + end + object Label3: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + Left = 65 + Height = 21 + Top = 79 + Width = 151 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 16 + Caption = 'Copyright 2013-2020' + Font.CharSet = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Pitch = fpVariable + Font.Quality = fqDraft + ParentColor = False + ParentFont = False + end + end +end diff --git a/applications/lazstats/source/forms/help/aboutunit.pas b/applications/lazstats/source/forms/help/aboutunit.pas new file mode 100644 index 000000000..0f7a8c03b --- /dev/null +++ b/applications/lazstats/source/forms/help/aboutunit.pas @@ -0,0 +1,50 @@ +unit AboutUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls; + +type + + { TAboutBox } + + TAboutBox = class(TForm) + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + OKButton: TButton; + Panel1: TPanel; + private + { Private declarations } + public + { Public declarations } + end; + +var + AboutBox: TAboutBox; + +procedure ShowAboutBox; + + +implementation + +procedure ShowAboutBox; +begin + with TAboutBox.Create(nil) do + try + ShowModal; + finally + Free; + end; +end; + + +initialization + {$I aboutunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/help/gridhelpunit.lfm b/applications/lazstats/source/forms/help/gridhelpunit.lfm new file mode 100644 index 000000000..a4aeb050a --- /dev/null +++ b/applications/lazstats/source/forms/help/gridhelpunit.lfm @@ -0,0 +1,58 @@ +object GridHelpFrm: TGridHelpFrm + Left = 131 + Height = 477 + Top = 101 + Width = 653 + Caption = 'Using the Grid and Files' + ClientHeight = 477 + ClientWidth = 653 + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Memo1: TMemo + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 8 + Height = 425 + Top = 8 + Width = 637 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Lines.Strings = ( + 'When you start LazStats you will see the grid with one empty cell. The column represents a variable and the row represents a "case", observation or subject of your study. Before you enter a value in that first cell, you should click on the Variables menu and select the Define Variables option. You will see a form that lets you specify a name or label for the variable as well as a longer title for the variable. In addition, you specify the type of variable (integer, floating point, character string), a missing value, and how you want the values entered to be displayed in the cell (justification.) Default values are provided but you can change these by clicking on a specification and entering your own. There are also "drop-down" boxes that let you select the type or justification for those specifications. It is a good idea to define all of your variables before you begin entering data. You can add additional variables in the Definition form by simply pressing the down arrow key on your key board and then change any default values to appropriate ones for your data.' + '' + 'Once you have specified the variables for the data grid and returned to the grid, you can then enter data for those variables you have defined. When you press the down arrow key on your keyboard, a new row will automatically appear to enter the next case. BE CAREFUL! It is easy to accidentally add new (blank) lines that should not be a part of your data file. Use the Edit menu and select the Delete Row for any row accidentally added to the grid.' + '' + 'Avoid leaving any cell blank. It is recommended that you use a value such as 99999 as a missing value until you have the correct value for that case and variable. Generally, it is NOT a good idea to have any missing data since not all procedures will work with missing data.' + '' + 'Once you have entered data (or need to take a break from data entry) it is time to save the grid data into a disk file. It is recommended that you save your data as a .LAZ file (the top option under the FILE menu.) This saves not only your data but also all of your variable definitions! You can, of course, also export your data to a .TAB or other file format commonly utilized by other programs. These other formats do NOT save the definitions of the variables!' + '' + 'Once you have entered data in a grid you will discover it is easy to "navigate" around the grid. Use the "home" key, "end" key, "page up" and "page down" keys as needed. The "TAB" key will move you from cell to cell in a case. You will also find procedures under the Variables menu and the Edit menu that lets you recode values in the grid, insert, copy and delete rows or columns, transform values in the grid, etc. Experiment! Try different options. There''s not much you can do to harm your computer with this program.' + ) + ReadOnly = True + ScrollBars = ssAutoVertical + TabOrder = 0 + end + object ReturnBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 287 + Height = 28 + Top = 441 + Width = 78 + Anchors = [akLeft, akBottom] + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 1 + end +end diff --git a/applications/lazstats/source/forms/help/gridhelpunit.pas b/applications/lazstats/source/forms/help/gridhelpunit.pas new file mode 100644 index 000000000..24b93868f --- /dev/null +++ b/applications/lazstats/source/forms/help/gridhelpunit.pas @@ -0,0 +1,33 @@ +unit GridHelpUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls; + +type + + { TGridHelpFrm } + + TGridHelpFrm = class(TForm) + ReturnBtn: TButton; + Memo1: TMemo; + private + { private declarations } + public + { public declarations } + end; + +var + GridHelpFrm: TGridHelpFrm; + +implementation + +initialization + {$I gridhelpunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/help/helpunit.lfm b/applications/lazstats/source/forms/help/helpunit.lfm new file mode 100644 index 000000000..e05716680 --- /dev/null +++ b/applications/lazstats/source/forms/help/helpunit.lfm @@ -0,0 +1,72 @@ +object HelpFrm: THelpFrm + Left = 239 + Height = 117 + Top = 107 + Width = 303 + AutoSize = True + Caption = 'HTML Help Viewer' + ClientHeight = 117 + ClientWidth = 303 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 251 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'PRESS THE Button for the TABLE OF CONTENTS!' + ParentColor = False + end + object HelpBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 28 + Top = 31 + Width = 154 + HelpType = htKeyword + HelpKeyword = 'HTML/LAZTOC.html' + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + Caption = 'Table of Contents' + OnClick = HelpBtnClick + TabOrder = 0 + end + object ReturnBtn: TButton + AnchorSideLeft.Control = HelpBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = HelpBtn + Left = 178 + Height = 27 + Top = 31 + Width = 85 + BorderSpacing.Left = 16 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 1 + end + object HTMLHelpDatabase1: THTMLHelpDatabase + BaseURL = 'file://html/' + AutoRegister = True + KeywordPrefix = 'HTML/' + left = 24 + top = 24 + end + object HTMLBrowserHelpViewer1: THTMLBrowserHelpViewer + BrowserParams = '%s' + AutoRegister = True + left = 168 + top = 24 + end +end diff --git a/applications/lazstats/source/forms/help/helpunit.pas b/applications/lazstats/source/forms/help/helpunit.pas new file mode 100644 index 000000000..b54cc3541 --- /dev/null +++ b/applications/lazstats/source/forms/help/helpunit.pas @@ -0,0 +1,56 @@ +unit HelpUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, LazHelpHTML, HelpIntfs; + +type + + { THelpFrm } + + THelpFrm = class(TForm) + ReturnBtn: TButton; + HelpBtn: TButton; + HTMLBrowserHelpViewer1: THTMLBrowserHelpViewer; + HTMLHelpDatabase1: THTMLHelpDatabase; + Label1: TLabel; + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + HelpFrm: THelpFrm; + +implementation + +{ THelpFrm } + +procedure THelpFrm.FormShow(Sender: TObject); +begin +// HelpBtnClick(self); +end; + +procedure THelpFrm.FormCreate(Sender: TObject); +begin + HTMLHelpDatabase1.BaseURL := 'file://html'; +end; + +procedure THelpFrm.HelpBtnClick(Sender: TObject); +begin + ShowHelpOrErrorForKeyword('','HTML/LAZTOC.html'); +end; + +initialization + {$I helpunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/maindm.lfm b/applications/lazstats/source/forms/maindm.lfm new file mode 100644 index 000000000..59d62f9a7 --- /dev/null +++ b/applications/lazstats/source/forms/maindm.lfm @@ -0,0 +1,154 @@ +object MainDataModule: TMainDataModule + OldCreateOrder = False + Height = 143 + HorizontalOffset = 817 + VerticalOffset = 349 + Width = 295 + PPI = 96 + object ImageList: TImageList + Scaled = True + left = 85 + top = 42 + Bitmap = { + 4C7A0400000010000000100000000D0300000000000078DAE557CF4B5451143E + CBFE82205A040A06AD02772DA2CCDE731CCD852D6A292442EB6AA799953AE368 + BB88D1D4B1C84561524188598A8AE664691AE938E6731003FF89D377CE1D750C + C679F72DF5C2C7DC77EFFBEEAF77BEEF9E6166E2630C7A52035C23EAAC228A85 + 18BF297DD6763FC0BBB14AA2B62BFC726B95297215638489BAAA0B203B87BC0B + 6EB7B7C034DECBF4BA91A9F532535B39537B3E608EA82B6B1DA66805B7FE9965 + 9AEE619A8AF3AD8D19AEF366B96E732E3F3249AEDF5E64E10AEEA4C698E6C14F + C6CDEF8F3EA685FEFC584C30FD1A0417E745542A6BADFFFD9E69057D23F7B17E + 59A383B370F343B80FDC713D3F1DC3E1EBA961F05C33A63F14EF7D03798E8599 + 1E572CFAFF7635F45F9131CF9245E163AE9FA3A17F9F3AEFAC8A673D82763DC2 + 6A2E78837A04F46EE6D631DFAA9645D3F9F42E5E209E20DE008F50AFD81D03FA + 152D8BA60FD53C3C41BC413C42BC423D43F51F325A164D1FA679F1841C8F50CF + 107E63F9908E7198D6C50BC413C41BE011EA15B227A3B733BEF50E6F508F8057 + E8B3954F03772F3D558FC8E5DA9553D9B51C59FD1F28129751976DF6BB57DACA + 38EE2D29A46EC547CC77AD25112FCF155A6FD77829CC8F55724B7A8E690231FB + B9DB00F587D286BE82FC47EE3C45105F4388D5C95E83A166D636F4F9587F89B9 + CFCAF876E61BD3D7446EAC97F83E3FECF7E626349A1C3073DB9E3FFC24EC4D40 + B709A3C100FC8B1BD0F8CFA07C87CF6F7C84B70CECDEE996F1E370B1F78E6935 + 28DFE593DE1BA674403E382732AF98BC80FC083CF1EFA0412464CF6F763E51B4 + 921552B7E51315E5786791355F734B773FCFB4E5471D7EB6B3CD0DE9E5031E62 + 13FFAD5B29A651C45FD409C4BFB709EFF9D21F98DFE0CD43FFC1E7BFB18EFB76 + 6620B0FE4269E8772E38FFC2DA28D3F71781F57B6EED03F28280F18FFBFEF42A + F4B79C3077BF5F7E67F5B4E60B234D4C4BF0FFA55E539735A0AFB0FF87B97665 + 986B77A6E03D3D0AA94B9BF4F958BFE619348639D7FB0CC69AF6FE97F8DC3FC6 + 406E34D96220F56CDE60A1DF52EA40AED211E6DC9CC3EAFEDED77FDEFBFB1F50 + EB76A4 + } + BitmapAdv = { + 4C69020000004C7A040000001800000018000000970600000000000078DAED99 + 7B4C935718C65F1CD3A2155A446E52EE549C779D9749E205F01215D4B839A7D3 + A813159DDB4459E6B2B87999D138279B13F88AB4459D22283A150A88329D0808 + 8ADCCA454296F9CF92FD339369CC647BF69E5216718BD93E8EFF719227EDD7D3 + 3E6F7B7A729EDF391F0042AF7AA552A5A5A5DD555BE95D7ABF3E8A9FBBFCA34F + 85BA359DC687DE9BA950CAE2477CA521B9CD85B646678EBC6C7AE89D9900BEF6 + 90E6ACD3F8B1B739EC6A0612EE55604CDE0E7859D6C3CBAA525989E89FBAFC3E + 857A4E24BD5B307D107B26BCE4F0E3F0EA1C4454656374630122ED051866B7A9 + 537331065FD80D0AD5CFE71A737467B7FF11783717549EC1323DA50C75AAC804 + E5260BFF85E4A37D95762DBA49D7BFECA03B4741B7B95F3CD664AA57AD0574EE + C34E7F22773278C4D1CE05E554F50DA8D10C2AF884FBB7A9D777EC7D74D5030A + D1CF61FF3E2C3D790F984D692BDAA83E0D94B912DC97CCF593546A0B7F7E15F5 + 730DFA7B6E12691D35F62DAEA2D4257FF275A098593D9096E5DA6DFE8BDF11E2 + B99466198F38C64D7EEBE3ACEDCBEA2BC370FAF4E92F54BD6B7CAF7AD5ABFFCC + 3FEAE4E26026C14ECFE31FF54DE36026C14E82A1E4370FC14C829D044339B3A4 + B38579C6F44F5BFEBB6016D5BCC3AC249849B0936028478DAEDF11AA8F17AC22 + 98452DEF085612CC24D8493014B3D4437A3F468C95AF832104AB086651CB3BCF + 30936029DD99ED8F98AD621CFE825504B3F484799E6627C15282A97CB4E3B9C6 + 02B2ACEE70304B4F984730936027C15082A504530946D0B846708DC41EB04E92 + 839504330976120C253847B048272FBCEC64919EB04E20A52D011D5CD24EBE03 + 1739D9C745E2FC7767664AE37158C9CFBD247B9393957C9D63F2522FFFF4EA45 + AB7B7AB86A69E9B8ED91D64D0F685B8CE5DF32A407FE2EF4E6D88F469EDBFFCB + D6966AC494981FD2BB33D29FADA1D2DF85E645AC0938FBF9AF0B6E17415F720C + 532B2F627231E754D28C6E39F5BFFD35AE3A5A3E215597B7E749F49D625011AF + EDC5BCFE169B30A2FC3C8C57ADA0E45833E9DC7C55F9870D9A49A9CB9E04E7ED + 8457DE2E44969F019564C0EBDA714416A722985F2365F5239A19B145AC932ABE + 7F0467F3265E7F93875A3620BEA1047445C1D08A1CC417A580A20CE9DCBF99F4 + 6E93C59AA362FCFB3AD7ED40A33511718DEC5FAAC0782B0771C55FF1FE58B7CC + 79C622CE715C7A307F7411EC3FCF7E19744DE10CCFC1BC2287FF4249F35317C6 + FEB3EDFC1FFFA020ACFA3466171D92EA1F62DD80187B21E8868290DBD988293C + 28D53F88FDA735DB40371504D564635AE11752FD0DCC68512DF9CC480A0C774F + 21AAF08038FF90E63FC4B20E935A2E826E2918527712930AF74BF5F763FFF1AD + 17989F14F8D57F8BF1B67D52FD7D2C09187DEF3CB399029F8613186DDB2BD57F + B0652D86DF3BC70CA960B0FD3886DBF648F5F762FFC8B63C509D02AF265E7F24 + FB7BB27F783BAF6F0D0A3C5B8E23DCB64BAABF87650D82DA734076051EAD5908 + B27D26D5DF9DFD037ECC0635A5C3BD2D0B01B64FA5FA6BAD6BE0F713FBB79AA0 + 6DCF825FE10EA9FE1AD38ADF74B58741D507A0A939045D5ED2630AF19C2FC95F + 4B334277526CB89562C2B22896151D76803C34AF48F21767988215825921CE47 + 7F969B2CFF7E87163506981361C85C8F00F306B81F79ABF3EC5DD2F8845A3762 + 95BD12532A0A1057538AD88294CEB37749FFAFD1B2917DAFF01ECE04E3F55CC4 + 157E2D75FD375A38DF6BAF3818C85826FCE5E66F04FBCFADE57C2FE67C2FCBC1 + 5C5B8ADC7C67FF59B59CEF259CEF374F63964D72BE335F45D771BE5FE57CAFC8 + 46B44D72BEF39C9C5AC7F9FE3DE77B6536A61648CE77F37A4CA9E77CBF6E82A1 + EA14A614C8CD777FF33A4C68B8042A33C1BFFA2426E44BCE77F61FD7C8F97ED3 + 04BFDB27312E5F72BE9B1330CACEF95EC9F95E7302A3F2E5E6BB97792D86D939 + 7FAB387F6B4F6058BEDCFC1DC4FEC6A6B3BCFE2B1854771CC6FCDD52FDF5E677 + 10DA9CEBE01F7DFD3184E6EF949BBFEC6F68E17CBFABC0BDE1180CF972F35D6B + E6FC6DE5FCADE3FCB573FE5E9290BFFEEEE329F1B5525A37F1C6808C95F06E3D + 09AA3761409315DE173E066D9EDCE0E89F6058A36A7FE43B702CED7BA38CEE1C + EEA07B166613DE9BDA4D9D6A35835A5847135A698CFFEB2AF777E2BE6A3CED5A + 504E821D5A8E720D05D4CC751A5241A736FD4C237CD6F2FB06ABDA9F3E7D5F35 + FDED36AAE71A6D5CA3391D94CDDE9383B671BF77D73D4CD5E7035DF755F72C2C + A7F2BD1D645AD5E6FCDEDE3D3A1F78F6BE6AA02E9EB9E7088DF45DEBE4155749 + F3B36BACDC9DDCE3F9ACF7F3FCFF022E5008124C7A0400000020000000200000 + 00040700000000000078DAED9B5D6C145514C74F425B9F082DA16BE2936F3E48 + 3460343128A4DF2D5F460CD16862D498F8608C0F901A0CB8B442B72D84446342 + EF6C13C02F444883A14029F4FB13289416E8872DD66E71B75BC18FF8664C8EE7 + 9C3BBBDBA5D4F070E7929899E49FB36766D2DFDD7B67A6F77FEE2C2202FAF2E5 + CBD743D0225B06D4AE3F050736F1095960775B027B0B1BE0780861FF7AE6E7D8 + 651734C0B1207E3C33865053C8FC8035F61E621F0FE2EBE3DD5839338250B906 + A12A1F21546050F49D6A4A90C6B751C63931DE7B8B3AA021886F4DF622B41EC4 + 2F6263B82936842FC76FE096F84D637A656E04B7FE3649FC12EEDBA5A44CA82D + BB03A72AF09DA93E842E07A15391EAE6499913FFFDFE23D407C5CCCF2565436D + 29AE1C6FC2472ED3FEFEB0C7AA47B8FA951E037D6DAD809DF9ED70B602E1DA21 + 84013AE7B2A3C59F4DEB0AF187D3F83C064FC1476B3BA06937C28DC30843F55A + FC79E44BB31A25F6C47734FE65097E86F401C06A694333F5C31871C7692C3EE5 + 6B9FC6A9BAC49CE4DA2776B0A8DB1D7F7DEFCD6F431BB52172549F0F504A2A30 + AC75A427DDBE87856D58D701BD5508FB3630FF09B79F4C2AD765672C7806E936 + 3C0355A5B7E1C0669BCFBFF96D08483F00ACB2FCFC4F6C99A465F26CB0FFFFCF + EAE6CF817CF9F2E5CB972FDFFF1BDEB2A486C0B58485734D1B5B8ED410B896C0 + 35053DB7B4B905B88620B584634194DAC2C23664C2FE8D7F882F616F6ED2EB73 + EDA0728DD412B8A6C0B505A931A4B7219BBD387B72F6E626BD3ED70EB886C0B5 + 04AE29486DA181DB90361601F1E2ECC993DEDF94EEA921D0DF971AC329F27755 + 25896B32207DCF9E9CBDB9C7FE9F6B0C5C6BE09A83EBC1349F3D397B732F3CFF + FC7A02D718B8D6C0350780E5C2673FCC9E9CBDB969BF7F6F3D816B0CECB1B9E6 + 90F8FEFB36FE256DA82931EBF5B976C03504AE25704D816B0B9ABDDAF5B919AE + C7639F99EF81CF2F9576702D816B0AE56BDBE7B197CCF39AD91E78FC80D40EB8 + 86C0B5843DC577C4D7A7B3BD7FFE710DA176FD9FF4F979D2A3969FC139EED83E + 4B7ACCED6B9B5B963BB6D90F81EDFB7F5FBEFEAFEB73D5C527A1966BE314FF63 + 6EED015FAF917DB30BC7FEFE07392E32AFF582AFD9DFEEC2C6BBB3F878E70989 + 9C2FD606837C669F80A39FE0C1E82D84332A29C969FFFDDA60889F4973F4287C + BF1BCB6F0DD11C8AE672E758611D2997FD741CAA8AD2DA60804FFE64C35D3819 + C2572706681E4FF3A8F361AD0BF5A9CFB45F8ED379102A3B93B8260DF0B3C543 + B28FE3EB7DCF8B78786E8A98D4F7171C8992D37E39CEE7E975EBA5C6F8A9F961 + 2984F2B1FED79F894D9EA24549949CF6BB6B4579EEDC7699217E963B8FD1F339 + E284EF10AF95F86D4AA2E49A9F582BCA49AC5B18BEFF02CC51CC6B237EBB92A8 + 52FC80C7F77F807DEDE77374BFB513BF4349949CFDAE25FEFEB909ED29BBB4C7 + 94DC22BF3A4E7EBA8BF8DD4AA2E416F915F1116213BF474994DC1ABF1077C6AF + 23F411BBCF912879A8D01ABF3C4ECFDA7EFAFEFD4AA2E416F91FCE0E225C24FE + 452551728BFCF763F49C1F20FE809228B945FEBBB14B0857887F454994DC22FF + CD581FC255E25F551225B7C87F2DDA83708DF8D79444C9ADF18B704BB40B6148 + 252539EDB7C5DF1CEB40185649496E915F1A6B43B8A19292DC223F2F761EE1A6 + 4A4A726BFC625C133B8730529794E4A1626BFCE766CF228CD3771FAB9328B945 + FEAAF8698409FADFF3A32351725BFC9A325CF97B13C2CC1184C8118992D794D9 + E0E742B0B05B58A1929438E7FDA9F7A9BCE22F75DF9B5AF700EF5379C1CF7019 + B90FF83E95793EBFB7C93E87DF4DAD2ED491F3F4F739BDEB7F626D9F1AC56D13 + C3B89D2491726983F7FD9F0BD505188E4D2334D2BDDFA8244A5E5D8016AE3FF1 + 3FE159E29D66EFEF4894DC9AFF217E9C784DCAF5FE4AE716F975B19F884DFC66 + 47A2E416FDDF6731F27BCD75BA064051728BFE675F7422CDFF4B6E91BF374AF7 + 5B0BF15B9544C92DF283BF8CA4D51F24B7E8FF76DCBEAEBD7F872351728BF3EF + 6DB787DCF565BD5E2DB945FE073383DAFB773B1225B7C87F6F66407BFF1E47A2 + E416F96FCF90DFEB257EAF2351728BFC3722BD69FE5B728BFE6B6BA41BE1924A + 4A728BFEE3A508F9ADCB2A29C92DF2CB226DAEF7D792DC22BF20D2E27A7F2DC9 + 2DFAAF1723CD088374ED0F2A8992DBF45F11F21B438EEBFF1D9D5BE317E1AA69 + F25BC34E52927BD7FF59F20E03BF47C1EF7254E6E1CAE91F10AE3B49494EFBE5 + 389FA77F3761AAFEBE0C2A8B5BA03384307D94FC2679BED17AF2FD4E4A9CF37E + 3ECEE7F1F9E6D61F784EFFB4FC26A57537C2E421F2DD61F2FD2A25CE793F1FE7 + F3F87C73EB2F19EEBC7E3594AFA53604356B9C98A34A476107518EEBF76B720D + AE3FA5FF368719EDC49A22E664BD8EED69EC1586D7DFEEDF86CE0A84E8D72871 + 11B627EBAF8936ECC8EB11DFCF7111B667EBCF9AC56B6C2FB87185A5F5E77BEB + 00CB17F3FD0FCAFF17E77E0F33 + } + end +end diff --git a/applications/lazstats/source/forms/maindm.pas b/applications/lazstats/source/forms/maindm.pas new file mode 100644 index 000000000..4e529e06d --- /dev/null +++ b/applications/lazstats/source/forms/maindm.pas @@ -0,0 +1,31 @@ +unit MainDM; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Controls; + +type + + { TMainDataModule } + + TMainDataModule = class(TDataModule) + ImageList: TImageList; + private + + public + + end; + +var + MainDataModule: TMainDataModule; + +implementation + +initialization + {$I maindm.lrs} + +end. + diff --git a/applications/lazstats/source/forms/mainunit.lfm b/applications/lazstats/source/forms/mainunit.lfm new file mode 100644 index 000000000..80bcdf79c --- /dev/null +++ b/applications/lazstats/source/forms/mainunit.lfm @@ -0,0 +1,1041 @@ +object OS3MainFrm: TOS3MainFrm + Left = 484 + Height = 519 + Top = 194 + Width = 725 + Caption = 'LazStats' + ClientHeight = 499 + ClientWidth = 725 + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + Font.Quality = fqDraft + Menu = MainMenu1 + OnCreate = FormCreate + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Panel1: TPanel + Left = 0 + Height = 35 + Top = 0 + Width = 725 + Align = alTop + BevelOuter = bvNone + ClientHeight = 35 + ClientWidth = 725 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 14 + Top = 10 + Width = 63 + BorderSpacing.Left = 12 + Caption = 'No. Cases' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = NoCasesEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 139 + Height = 14 + Top = 10 + Width = 91 + BorderSpacing.Left = 16 + Caption = 'No. Variables' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = NoVarsEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 302 + Height = 14 + Top = 10 + Width = 91 + BorderSpacing.Left = 16 + Caption = 'Current File:' + ParentColor = False + end + object NoCasesEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 83 + Height = 22 + Top = 6 + Width = 40 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabStop = False + TabOrder = 0 + Text = 'NoCasesEdit' + end + object NoVarsEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 238 + Height = 22 + Top = 6 + Width = 48 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabStop = False + TabOrder = 1 + Text = 'NoVarsEdit' + end + object FileNameEdit: TEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 401 + Height = 22 + Top = 6 + Width = 316 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + TabStop = False + TabOrder = 2 + Text = 'FileNameEdit' + end + end + object Panel2: TPanel + Left = 0 + Height = 41 + Top = 458 + Width = 725 + Align = alBottom + BevelOuter = bvNone + ClientHeight = 41 + ClientWidth = 725 + TabOrder = 1 + object Label4: TLabel + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Panel2 + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 14 + Top = 13 + Width = 28 + BorderSpacing.Left = 12 + Caption = 'Row:' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = RowEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + AnchorSideTop.Side = asrCenter + Left = 137 + Height = 14 + Top = 13 + Width = 49 + BorderSpacing.Left = 16 + Caption = 'Column:' + ParentColor = False + end + object Label6: TLabel + AnchorSideLeft.Control = ColEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + AnchorSideTop.Side = asrCenter + Left = 275 + Height = 14 + Top = 13 + Width = 91 + BorderSpacing.Left = 16 + Caption = 'Filter Status' + ParentColor = False + end + object RowEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + AnchorSideTop.Side = asrCenter + Left = 48 + Height = 22 + Top = 9 + Width = 73 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabStop = False + TabOrder = 0 + Text = 'RowEdit' + end + object ColEdit: TEdit + AnchorSideLeft.Control = Label5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + AnchorSideTop.Side = asrCenter + Left = 194 + Height = 22 + Top = 9 + Width = 65 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabStop = False + TabOrder = 1 + Text = 'ColEdit' + end + object FilterEdit: TEdit + AnchorSideLeft.Control = Label6 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + AnchorSideTop.Side = asrCenter + Left = 374 + Height = 22 + Top = 9 + Width = 231 + BorderSpacing.Left = 8 + TabStop = False + TabOrder = 2 + Text = 'FilterEdit' + end + end + object DataGrid: TStringGrid + Left = 8 + Height = 423 + Top = 35 + Width = 709 + Align = alClient + AutoEdit = False + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + ColCount = 2 + DefaultColWidth = 80 + MouseWheelOption = mwGrid + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goColSizing, goEditing, goTabs, goThumbTracking, goSmoothScroll] + RowCount = 2 + TabOrder = 2 + TabStop = False + TitleFont.CharSet = ANSI_CHARSET + TitleFont.Color = clBlack + TitleFont.Height = -11 + TitleFont.Name = 'Courier New' + TitleFont.Pitch = fpFixed + TitleFont.Quality = fqDraft + OnClick = DataGridClick + OnKeyDown = DataGridKeyDown + OnKeyPress = DataGridKeyPress + OnPrepareCanvas = DataGridPrepareCanvas + end + object MainMenu1: TMainMenu + left = 192 + top = 200 + object MenuItem1: TMenuItem + Caption = 'File' + object NewFileBtn: TMenuItem + Caption = 'New File' + OnClick = NewFileBtnClick + end + object OpenFileBtn: TMenuItem + Caption = 'Open File (*.laz)' + OnClick = OpenFileBtnClick + end + object SaveFileBtn: TMenuItem + Caption = 'Save File (*.laz)' + OnClick = SaveFileBtnClick + end + object CloseFileBtn: TMenuItem + Caption = 'Close File' + OnClick = CloseFileBtnClick + end + object MenuItem42: TMenuItem + Caption = '-' + end + object MenuItem13: TMenuItem + Caption = 'Import File of Type' + object TabFileInBtn: TMenuItem + Caption = 'TAB Separated' + OnClick = TabFileInBtnClick + end + object CSVFileIn: TMenuItem + Caption = 'Comma Separated' + OnClick = CSVFileInClick + end + object SSVFileIn: TMenuItem + Caption = 'Space Separated' + OnClick = SSVFileInClick + end + end + object TabFileOut: TMenuItem + Caption = 'Export File of Type' + object MenuItem20: TMenuItem + Caption = 'Tab Separated' + OnClick = MenuItem20Click + end + object CSVFileOut: TMenuItem + Caption = 'Comma Separated' + OnClick = CSVFileOutClick + end + object SSVFileOut: TMenuItem + Caption = 'Space Separated' + OnClick = SSVFileOutClick + end + end + object MenuItem12: TMenuItem + Caption = '-' + end + object MenuItem16: TMenuItem + Caption = 'Exit' + OnClick = MenuItem16Click + end + end + object MenuItem2: TMenuItem + Caption = 'Variables' + object DefineVar: TMenuItem + Caption = 'Define' + OnClick = DefineVarClick + end + object PrintDefs: TMenuItem + Caption = 'Print Definitions' + OnClick = PrintDefsClick + end + object Transform: TMenuItem + Caption = 'Transform Variables' + OnClick = TransformClick + end + object Recode: TMenuItem + Caption = 'Recode Variables' + OnClick = RecodeClick + end + object Equation: TMenuItem + Caption = 'Equation Editor' + OnClick = EquationClick + end + end + object MenuItem3: TMenuItem + Caption = 'Tools' + object FormatGrid: TMenuItem + Caption = 'Format Grid Cells' + OnClick = FormatGridClick + end + object SortCases: TMenuItem + Caption = 'Sort Cases' + OnClick = SortCasesClick + end + object PrintGrid: TMenuItem + Caption = 'Print Grid File' + OnClick = PrintGridClick + end + object MenuItem28: TMenuItem + Caption = 'Show Output Form' + OnClick = MenuItem28Click + end + object SelectCases: TMenuItem + Caption = 'Select Cases' + OnClick = SelectCasesClick + end + object LoadSubFile: TMenuItem + Caption = 'Load a Sub File' + end + object MenuItem30: TMenuItem + Caption = 'Swap Rows and Columns of Grid' + OnClick = MenuItem30Click + end + object SwapDecType: TMenuItem + Caption = 'Change English to European or Vice Versa' + OnClick = SwapDecTypeClick + end + object StrToIntegers: TMenuItem + Caption = 'Convert strings to integer codes' + OnClick = StrToIntegersClick + end + object smooth: TMenuItem + Caption = 'Smooth Data in a Variable' + OnClick = smoothClick + end + object MenuItem15: TMenuItem + Caption = '-' + end + object Calculater: TMenuItem + Caption = 'Calculator' + OnClick = CalculaterClick + end + object JPEGView: TMenuItem + Caption = 'JPEG Image Viewer' + OnClick = JPEGViewClick + end + end + object MenuItem4: TMenuItem + Caption = 'Edit' + object blockcopy: TMenuItem + Caption = 'Copy a Block of Cells' + OnClick = blockcopyClick + end + object BlockPaste: TMenuItem + Caption = 'Paste a Block of Cells' + OnClick = BlockPasteClick + end + object BlockCut: TMenuItem + Caption = 'Cut a Block of Cells' + Visible = False + end + object MenuItem49: TMenuItem + Caption = '-' + end + object InsNewCol: TMenuItem + Caption = 'Insert New Column Before Current One' + OnClick = InsNewColClick + end + object CopyCol: TMenuItem + Caption = 'Copy Column' + OnClick = CopyColClick + end + object CutCol: TMenuItem + Caption = 'Cut Column' + OnClick = CutColClick + end + object PasteCol: TMenuItem + Caption = 'Paste Column' + OnClick = PasteColClick + end + object MenuItem48: TMenuItem + Caption = '-' + end + object NewRow: TMenuItem + Caption = 'Insert New Row' + OnClick = NewRowClick + end + object CopyRow: TMenuItem + Caption = 'Copy Row' + OnClick = CopyRowClick + end + object CutRow: TMenuItem + Caption = 'Cut Row' + OnClick = CutRowClick + end + object PasteRow: TMenuItem + Caption = 'Paste Row' + OnClick = PasteRowClick + end + end + object MenuItem5: TMenuItem + Caption = 'Analyses' + object MenuItem32: TMenuItem + Caption = 'Descriptive' + object Distributions: TMenuItem + Caption = 'Distribution Statistics' + OnClick = DistributionsClick + end + object FreqAnal: TMenuItem + Caption = 'Frequency Analysis' + OnClick = FreqAnalClick + end + object GrpFreq: TMenuItem + Caption = 'Plot Group Frequencies' + OnClick = GrpFreqClick + end + object CrossTabs: TMenuItem + Caption = 'Cross Tabulation' + OnClick = CrossTabsClick + end + object Breakdown: TMenuItem + Caption = 'Breakdown' + OnClick = BreakdownClick + end + object BoxPlot: TMenuItem + Caption = 'Box Plot' + OnClick = BoxPlotClick + end + object NormalityTests: TMenuItem + Caption = 'Normality Tests' + OnClick = NormalityTestsClick + end + object ThreeDRotate: TMenuItem + Caption = '3-D Variable Rotation' + OnClick = ThreeDRotateClick + end + object PlotXvsY: TMenuItem + Caption = 'Plot X vs Y' + OnClick = PlotXvsYClick + end + object BubblePlot: TMenuItem + Caption = 'Repeated Measures Bubble Plot' + OnClick = BubblePlotClick + end + object StemLeaf: TMenuItem + Caption = 'Stem and Leaf Plot' + OnClick = StemLeafClick + end + object MultXvsY: TMenuItem + Caption = 'Multiple Group X vs Y Plot' + OnClick = MultXvsYClick + end + object XvsMultY: TMenuItem + Caption = 'X versus Multiple Y Plot' + OnClick = XvsMultYClick + end + object CompareDists: TMenuItem + Caption = 'Compare Distributions' + OnClick = CompareDistsClick + end + object ResistanceLine: TMenuItem + Caption = 'Resistant Line for Bivariate Data' + OnClick = ResistanceLineClick + end + object DataSmooth: TMenuItem + Caption = 'Data Smoothing' + OnClick = DataSmoothClick + end + object homotest: TMenuItem + Caption = 'Brown-Forsythe Test for Homogeneity of Variance' + OnClick = homotestClick + end + end + object OneSampTests: TMenuItem + Caption = 'One Sample Tests' + OnClick = OneSampTestsClick + end + object MenuItem34: TMenuItem + Caption = 'Comparisons' + object PropDiff: TMenuItem + Caption = 'Difference beween Proportions' + OnClick = PropDiffClick + end + object CorrDiff: TMenuItem + Caption = 'Difference Between Correlations' + OnClick = CorrDiffClick + end + object ttests: TMenuItem + Caption = 't-tests' + OnClick = ttestsClick + end + object Anova: TMenuItem + Caption = '1,2 or 3 Way ANOVAs' + OnClick = AnovaClick + end + object WithinAnova: TMenuItem + Caption = 'Within Subjects ANOVA' + OnClick = WithinAnovaClick + end + object AxSAnova: TMenuItem + Caption = 'A x S ANOVA' + OnClick = AxSAnovaClick + end + object ABSAnova: TMenuItem + Caption = 'A x B x S ANOVA' + OnClick = ABSAnovaClick + end + object BinA: TMenuItem + Caption = 'B Nested in A ANOVA' + OnClick = BinAClick + end + object NestedABC: TMenuItem + Caption = 'ABC ANOVA with B Nested in A' + OnClick = NestedABCClick + end + object OneCaseAnova: TMenuItem + Caption = '2 or 3 Way ANOVA with One Case Per Cell' + OnClick = OneCaseAnovaClick + end + object Ancova: TMenuItem + Caption = 'ANCOVA by Regression' + OnClick = AncovaClick + end + object GLM: TMenuItem + Caption = 'General Linear Model' + OnClick = GLMClick + end + object LatinSquares: TMenuItem + Caption = 'Latin and Greco-Latin Squares' + OnClick = LatinSquaresClick + end + end + object MenuItem35: TMenuItem + Caption = 'Correlation' + object MenuItem71: TMenuItem + Caption = 'Product-Moment' + OnClick = MenuItem71Click + end + object MenuItem72: TMenuItem + Caption = 'Partial, Semipartial' + OnClick = MenuItem72Click + end + object MenuItem73: TMenuItem + Caption = 'Autocorrelation' + OnClick = MenuItem73Click + end + object MenuItem74: TMenuItem + Caption = 'Canonical' + OnClick = MenuItem74Click + end + end + object MenuItem36: TMenuItem + Caption = 'Multiple Regression' + object LSMRitem: TMenuItem + Caption = 'Least Squares Multiple Regression' + OnClick = LSMRitemClick + end + object MenuItem75: TMenuItem + Caption = 'Forward Stepwise' + OnClick = MenuItem75Click + end + object MenuItem76: TMenuItem + Caption = 'Backward Stepwise' + OnClick = MenuItem76Click + end + object MenuItem77: TMenuItem + Caption = 'Simultaneous' + OnClick = MenuItem77Click + end + object MenuItem78: TMenuItem + Caption = 'Block Entry' + OnClick = MenuItem78Click + end + object MenuItem79: TMenuItem + Caption = 'Best Combination' + OnClick = MenuItem79Click + end + object MenuItem80: TMenuItem + Caption = 'Binary Logistic' + OnClick = MenuItem80Click + end + object MenuItem81: TMenuItem + Caption = 'Cox Proportional Hazzards Survival Regression' + OnClick = MenuItem81Click + end + object MenuItem82: TMenuItem + Caption = 'Linear Programming' + OnClick = MenuItem82Click + end + object TwoSLSReg: TMenuItem + Caption = 'Two Stage Least Squares Regression' + OnClick = TwoSLSRegClick + end + object WLSReg: TMenuItem + Caption = 'Weighted Least Squares Regression' + OnClick = WLSRegClick + end + end + object MenuItem37: TMenuItem + Caption = 'Multivariate' + object MenuItem83: TMenuItem + Caption = 'MANOVA / Discriminant Function' + OnClick = MenuItem83Click + end + object MenuItem84: TMenuItem + Caption = 'Hierarchical Analysis' + OnClick = MenuItem84Click + end + object MenuItem29: TMenuItem + Caption = 'Average Link Clustering' + OnClick = MenuItem29Click + end + object MenuItem31: TMenuItem + Caption = 'K Means Clustering' + OnClick = MenuItem31Click + end + object MenuItem33: TMenuItem + Caption = 'Single Link Clustering' + OnClick = MenuItem33Click + end + object MenuItem85: TMenuItem + Caption = 'Path Analysis' + OnClick = MenuItem85Click + end + object MenuItem86: TMenuItem + Caption = 'Factor Analysis' + OnClick = MenuItem86Click + end + object MenuItem87: TMenuItem + Caption = 'Canonical Correlation' + OnClick = MenuItem87Click + end + object MenuItem88: TMenuItem + Caption = 'General Linear Model' + OnClick = MenuItem88Click + end + object BartlettTest: TMenuItem + Caption = 'Bartlett Test of Sphericity' + OnClick = BartlettTestClick + end + object Correspondence: TMenuItem + Caption = 'Correspondence Analysis' + OnClick = CorrespondenceClick + end + object MedianPolish: TMenuItem + Caption = 'Median Polishing for a 2x2 Table' + OnClick = MedianPolishClick + end + end + object MenuItem38: TMenuItem + Caption = 'Cross-Classification' + object MenuItem89: TMenuItem + Caption = 'AxB Log Linear' + OnClick = MenuItem89Click + end + object MenuItem90: TMenuItem + Caption = 'AxBxC Log Linear' + OnClick = MenuItem90Click + end + object MenuItem91: TMenuItem + Caption = 'Log Linear Screen' + OnClick = MenuItem91Click + end + end + object MenuItem39: TMenuItem + Caption = 'Measurement Programs' + object MenuItem92: TMenuItem + Caption = 'Generate Sample Test Data' + OnClick = MenuItem92Click + end + object MenuItem93: TMenuItem + Caption = 'Classical Test Analysis' + OnClick = MenuItem93Click + end + object MenuItem94: TMenuItem + Caption = 'Rasch Test Calibration' + OnClick = MenuItem94Click + end + object MenuItem95: TMenuItem + Caption = 'Successive Interval Scaling' + OnClick = MenuItem95Click + end + object MenuItem96: TMenuItem + Caption = 'Guttman Scalogram Analysis' + OnClick = MenuItem96Click + end + object MenuItem97: TMenuItem + Caption = 'Weighted Composite Reliability' + OnClick = MenuItem97Click + end + object MenuItem98: TMenuItem + Caption = 'Kuder-Richardson #21 Reliability' + OnClick = MenuItem98Click + end + object MenuItem99: TMenuItem + Caption = 'Spearman-Brown Prophecy Reliability' + OnClick = MenuItem99Click + end + object MenuItem100: TMenuItem + Caption = 'Reliability Due to Test Variance Change' + OnClick = MenuItem100Click + end + object MenuItem101: TMenuItem + Caption = 'Differential Item Functioning' + OnClick = MenuItem101Click + end + object MenuItem102: TMenuItem + Caption = 'Polytomous DIF Analysis' + OnClick = MenuItem102Click + end + object MenuItem43: TMenuItem + Caption = '-' + end + object GrdBkMnu: TMenuItem + Caption = 'Grade Book' + OnClick = GrdBkMnuClick + end + object ItemBankMenuItem: TMenuItem + Caption = 'Item Banking' + OnClick = ItemBankMenuItemClick + end + end + object MenuItem40: TMenuItem + Caption = 'Nonparametric' + object SimpChiSqr: TMenuItem + Caption = 'Simple ChiSquare for Categories' + OnClick = SimpChiSqrClick + end + object MenuItem103: TMenuItem + Caption = 'Contingency Chi Square' + OnClick = MenuItem103Click + end + object MenuItem104: TMenuItem + Caption = 'Spearman Rank Correlation' + OnClick = MenuItem104Click + end + object MenuItem105: TMenuItem + Caption = 'Mann-Whitney U Test' + OnClick = MenuItem105Click + end + object MenuItem106: TMenuItem + Caption = 'Fisher''s Exact Test' + OnClick = MenuItem106Click + end + object MenuItem107: TMenuItem + Caption = 'Kendall''s Coefficient of Concordance' + OnClick = MenuItem107Click + end + object MenuItem108: TMenuItem + Caption = 'Kruskal-Wallis One Way ANOVA' + OnClick = MenuItem108Click + end + object MenuItem109: TMenuItem + Caption = 'Wilcoxon Matched Pairs Signed Ranks Test' + OnClick = MenuItem109Click + end + object MenuItem110: TMenuItem + Caption = 'Cochran Q Test' + OnClick = MenuItem110Click + end + object MenuItem111: TMenuItem + Caption = 'Sign Test' + OnClick = MenuItem111Click + end + object MenuItem112: TMenuItem + Caption = 'Friedman Two Way ANOVA' + OnClick = MenuItem112Click + end + object MenuItem113: TMenuItem + Caption = 'Probability of a binomial event' + OnClick = MenuItem113Click + end + object MenuItem114: TMenuItem + Caption = 'Kendall''s Tau and Parrtial Tau' + OnClick = MenuItem114Click + end + object MenuItem115: TMenuItem + Caption = 'Kaplan-Meier Survival Analysis' + OnClick = MenuItem115Click + end + object RiditAnalysis: TMenuItem + Caption = 'RIDIT Analysis' + OnClick = RiditAnalysisClick + end + object WghtedKappa: TMenuItem + Caption = 'Kappa and Weighted Kappa' + OnClick = WghtedKappaClick + end + object GenKappa: TMenuItem + Caption = 'Generalized Kappa' + OnClick = GenKappaClick + end + object RunsTest: TMenuItem + Caption = 'Runs Test for Normality' + OnClick = RunsTestClick + end + object Sens: TMenuItem + Caption = 'Sen''s Slope Analysis' + OnClick = SensClick + end + object KSTest: TMenuItem + Caption = 'Kolmogorov-Smirnov Test' + OnClick = KSTestClick + end + object SRHItem: TMenuItem + Caption = 'Scheirer-Ray-Hart 2-way ANOVA' + OnClick = SRHItemClick + end + object lifetable: TMenuItem + Caption = 'Life Table' + OnClick = lifetableClick + end + end + object MenuItem41: TMenuItem + Caption = 'Statistical Process Control' + object MenuItem116: TMenuItem + Caption = 'XBAR Chart' + OnClick = MenuItem116Click + end + object MenuItem117: TMenuItem + Caption = 'Range Chart' + OnClick = MenuItem117Click + end + object MenuItem118: TMenuItem + Caption = 'S Control Chart' + OnClick = MenuItem118Click + end + object MenuItem6: TMenuItem + Caption = 'CUMSUM Chart' + OnClick = MenuItem6Click + end + object MenuItem119: TMenuItem + Caption = 'Defect (nonconformity) c Chart' + OnClick = MenuItem119Click + end + object pcontrochart: TMenuItem + Caption = 'p Control Chart' + OnClick = pcontrochartClick + end + object MenuItem120: TMenuItem + Caption = 'Defects per Unit u Chart' + OnClick = MenuItem120Click + end + end + object MenuItem9: TMenuItem + Caption = 'Financial' + object MenuItem10: TMenuItem + Caption = 'Loan Amortization Schedule' + OnClick = MenuItem10Click + end + object MenuItem11: TMenuItem + Caption = 'Sum of years digits depreciation' + OnClick = MenuItem11Click + end + object MenuItem14: TMenuItem + Caption = 'Straight line depreciation' + OnClick = MenuItem14Click + end + object MenuItem17: TMenuItem + Caption = 'Internal rate of return' + Visible = False + end + object MenuItem18: TMenuItem + Caption = 'Present Value' + Visible = False + end + object MenuItem19: TMenuItem + Caption = 'Period Payment' + Visible = False + end + object MenuItem21: TMenuItem + Caption = 'Payment' + Visible = False + end + object MenuItem22: TMenuItem + Caption = 'No. of Periods' + Visible = False + end + object MenuItem23: TMenuItem + Caption = 'Net Present Value' + Visible = False + end + object MenuItem24: TMenuItem + Caption = 'Interest Rate' + Visible = False + end + object MenuItem25: TMenuItem + Caption = 'Interest Payment' + Visible = False + end + object MenuItem26: TMenuItem + Caption = 'Future Value' + Visible = False + end + object MenuItem27: TMenuItem + Caption = 'Double Declining Value' + OnClick = MenuItem27Click + end + end + object MatManMnu: TMenuItem + Caption = 'Matrix Manipulation' + OnClick = MatManMnuClick + end + end + object Option: TMenuItem + Caption = 'Options' + object ShowOpts: TMenuItem + Caption = 'Show Options' + OnClick = OptionClick + end + object PicView: TMenuItem + Caption = 'View Pictures' + Visible = False + end + end + object MenuItem7: TMenuItem + Caption = 'Simulations' + object ScatPlot: TMenuItem + Caption = 'Bivariate Scatter Plot' + OnClick = ScatPlotClick + end + object MultDists: TMenuItem + Caption = 'Multivariate Distribution' + OnClick = MultDistsClick + end + object TypeErrors: TMenuItem + Caption = 'Type 1 and Type 2 Error Curves' + OnClick = TypeErrorsClick + end + object Power: TMenuItem + Caption = 'Power Curves for a z test' + OnClick = PowerClick + end + object DistPlots: TMenuItem + Caption = 'Distribution Plots and Critical Values' + OnClick = DistPlotsClick + end + object SeqValues: TMenuItem + Caption = 'Generate Sequential Values' + OnClick = SeqValuesClick + end + object RandomVals: TMenuItem + Caption = 'Random Theoretical Values' + OnClick = RandomValsClick + end + object Probabilities: TMenuItem + Caption = 'Probabilities' + object probgtz: TMenuItem + Caption = 'Probability > z' + OnClick = probgtzClick + end + object Probltz: TMenuItem + Caption = 'Probability < z' + OnClick = ProbltzClick + end + object probzbetween: TMenuItem + Caption = 'Prob between 2 z values' + OnClick = probzbetweenClick + end + object MenuItem45: TMenuItem + Caption = '-' + end + object inversez: TMenuItem + Caption = 'z for a given cum. Probability' + OnClick = inversezClick + end + object MenuItem44: TMenuItem + Caption = '-' + end + object Chiprob: TMenuItem + Caption = 'Chisquare Probability' + OnClick = ChiprobClick + end + object tprob: TMenuItem + Caption = 'Student t probability' + OnClick = tprobClick + end + object Fprob: TMenuItem + Caption = 'F probability' + OnClick = FprobClick + end + object HypergeoProb: TMenuItem + Caption = 'Hypergeometric probability' + OnClick = HypergeoProbClick + end + end + end + object MenuItem8: TMenuItem + Caption = 'Help' + object About: TMenuItem + Caption = 'About...' + OnClick = AboutClick + end + object MenuItem46: TMenuItem + Caption = '-' + end + object GridUse: TMenuItem + Caption = 'Using the Grid' + OnClick = GridUseClick + end + object HelpContents: TMenuItem + Caption = 'General Help' + OnClick = HelpContentsClick + end + end + end + object OpenDialog1: TOpenDialog + left = 312 + top = 200 + end + object SaveDialog1: TSaveDialog + left = 432 + top = 200 + end +end diff --git a/applications/lazstats/source/forms/mainunit.pas b/applications/lazstats/source/forms/mainunit.pas new file mode 100644 index 000000000..e911d7e12 --- /dev/null +++ b/applications/lazstats/source/forms/mainunit.pas @@ -0,0 +1,1947 @@ +// File for testing: "GeneChips.laz" +// Y --> Dependent +// Chip --> Factor 1 +// Probe --> Factor 2 (Factor 3 empty) + +unit MainUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + Menus, ExtCtrls, StdCtrls, Grids, + Globals, DataProcs, DictionaryUnit; + +type + + { TOS3MainFrm } + + TOS3MainFrm = class(TForm) + ColEdit: TEdit; + FilterEdit: TEdit; + Label5: TLabel; + Label6: TLabel; + MenuItem10: TMenuItem; + MenuItem100: TMenuItem; + MenuItem101: TMenuItem; + MenuItem102: TMenuItem; + MenuItem103: TMenuItem; + MenuItem104: TMenuItem; + MenuItem105: TMenuItem; + MenuItem106: TMenuItem; + MenuItem107: TMenuItem; + MenuItem108: TMenuItem; + MenuItem109: TMenuItem; + MenuItem11: TMenuItem; + MenuItem110: TMenuItem; + MenuItem111: TMenuItem; + MenuItem112: TMenuItem; + MenuItem113: TMenuItem; + MenuItem114: TMenuItem; + MenuItem115: TMenuItem; + MenuItem116: TMenuItem; + MenuItem117: TMenuItem; + MenuItem118: TMenuItem; + MenuItem119: TMenuItem; + MenuItem12: TMenuItem; + MenuItem120: TMenuItem; + About: TMenuItem; + CloseFileBtn: TMenuItem; + MenuItem14: TMenuItem; + MenuItem15: TMenuItem; + MenuItem17: TMenuItem; + MenuItem18: TMenuItem; + MenuItem19: TMenuItem; + MenuItem21: TMenuItem; + MenuItem22: TMenuItem; + MenuItem23: TMenuItem; + MenuItem24: TMenuItem; + MenuItem25: TMenuItem; + MenuItem26: TMenuItem; + MenuItem27: TMenuItem; + blockcopy: TMenuItem; + BlockPaste: TMenuItem; + BlockCut: TMenuItem; + GridUse: TMenuItem; + MenuItem28: TMenuItem; + MenuItem29: TMenuItem; + MenuItem31: TMenuItem; + MenuItem33: TMenuItem; + GenKappa: TMenuItem; + CompareDists: TMenuItem; + MatManMnu: TMenuItem; + GrdBkMnu: TMenuItem; + inversez: TMenuItem; + Chiprob: TMenuItem; + Fprob: TMenuItem; + HypergeoProb: TMenuItem; + BinA: TMenuItem; + BartlettTest: TMenuItem; + GrpFreq: TMenuItem; + Correspondence: TMenuItem; + KSTest: TMenuItem; + Equation: TMenuItem; + Calculater: TMenuItem; + JPEGView: TMenuItem; + MedianPolish: TMenuItem; + DataSmooth: TMenuItem; + ItemBankMenuItem: TMenuItem; + homotest: TMenuItem; + lifetable: TMenuItem; + LSMRitem: TMenuItem; + MenuItem42: TMenuItem; + MenuItem43: TMenuItem; + MenuItem44: TMenuItem; + MenuItem45: TMenuItem; + MenuItem46: TMenuItem; + MenuItem48: TMenuItem; + MenuItem49: TMenuItem; + SimpChiSqr: TMenuItem; + SRHItem: TMenuItem; + OneCaseAnova: TMenuItem; + ResistanceLine: TMenuItem; + Sens: TMenuItem; + XvsMultY: TMenuItem; + RunsTest: TMenuItem; + smooth: TMenuItem; + NestedABC: TMenuItem; + tprob: TMenuItem; + probzbetween: TMenuItem; + Probltz: TMenuItem; + probgtz: TMenuItem; + Probabilities: TMenuItem; + StrToIntegers: TMenuItem; + SwapDecType: TMenuItem; + PicView: TMenuItem; + ShowOpts: TMenuItem; + WghtedKappa: TMenuItem; + WLSReg: TMenuItem; + TwoSLSReg: TMenuItem; + RiditAnalysis: TMenuItem; + MenuItem6: TMenuItem; + MenuItem9: TMenuItem; + pcontrochart: TMenuItem; + OpenDialog1: TOpenDialog; + SaveDialog1: TSaveDialog; + HelpContents: TMenuItem; + InsNewCol: TMenuItem; + CopyCol: TMenuItem; + CutCol: TMenuItem; + PasteCol: TMenuItem; + NewRow: TMenuItem; + CopyRow: TMenuItem; + CutRow: TMenuItem; + PasteRow: TMenuItem; + MenuItem71: TMenuItem; + MenuItem72: TMenuItem; + MenuItem73: TMenuItem; + MenuItem74: TMenuItem; + MenuItem75: TMenuItem; + MenuItem76: TMenuItem; + MenuItem77: TMenuItem; + MenuItem78: TMenuItem; + MenuItem79: TMenuItem; + MenuItem80: TMenuItem; + MenuItem81: TMenuItem; + MenuItem82: TMenuItem; + MenuItem83: TMenuItem; + MenuItem84: TMenuItem; + MenuItem85: TMenuItem; + MenuItem86: TMenuItem; + MenuItem87: TMenuItem; + MenuItem88: TMenuItem; + MenuItem89: TMenuItem; + MenuItem90: TMenuItem; + MenuItem91: TMenuItem; + MenuItem92: TMenuItem; + MenuItem93: TMenuItem; + MenuItem94: TMenuItem; + MenuItem95: TMenuItem; + MenuItem96: TMenuItem; + MenuItem97: TMenuItem; + MenuItem98: TMenuItem; + MenuItem99: TMenuItem; + RowEdit: TEdit; + FileNameEdit: TEdit; + Label3: TLabel; + Label4: TLabel; + NoVarsEdit: TEdit; + Label2: TLabel; + NoCasesEdit: TEdit; + Label1: TLabel; + MainMenu1: TMainMenu; + MenuItem1: TMenuItem; + OpenFileBtn: TMenuItem; + NewFileBtn: TMenuItem; + MenuItem13: TMenuItem; + TabFileOut: TMenuItem; + MenuItem16: TMenuItem; + TabFileInBtn: TMenuItem; + CSVFileIn: TMenuItem; + SSVFileIn: TMenuItem; + MenuItem2: TMenuItem; + MenuItem20: TMenuItem; + CSVFileOut: TMenuItem; + SSVFileOut: TMenuItem; + DefineVar: TMenuItem; + PrintDefs: TMenuItem; + Transform: TMenuItem; + Recode: TMenuItem; + FormatGrid: TMenuItem; + SortCases: TMenuItem; + PrintGrid: TMenuItem; + MenuItem3: TMenuItem; + SelectCases: TMenuItem; + LoadSubFile: TMenuItem; + MenuItem32: TMenuItem; + OneSampTests: TMenuItem; + MenuItem34: TMenuItem; + MenuItem35: TMenuItem; + MenuItem36: TMenuItem; + MenuItem37: TMenuItem; + MenuItem38: TMenuItem; + MenuItem39: TMenuItem; + MenuItem4: TMenuItem; + MenuItem40: TMenuItem; + MenuItem41: TMenuItem; + Distributions: TMenuItem; + FreqAnal: TMenuItem; + CrossTabs: TMenuItem; + Breakdown: TMenuItem; + BoxPlot: TMenuItem; + NormalityTests: TMenuItem; + ThreeDRotate: TMenuItem; + PlotXvsY: TMenuItem; + MenuItem5: TMenuItem; + BubblePlot: TMenuItem; + StemLeaf: TMenuItem; + MultXvsY: TMenuItem; + PropDiff: TMenuItem; + CorrDiff: TMenuItem; + ttests: TMenuItem; + Anova: TMenuItem; + WithinAnova: TMenuItem; + AxSAnova: TMenuItem; + ABSAnova: TMenuItem; + Option: TMenuItem; + Ancova: TMenuItem; + GLM: TMenuItem; + LatinSquares: TMenuItem; + ScatPlot: TMenuItem; + MultDists: TMenuItem; + TypeErrors: TMenuItem; + Power: TMenuItem; + DistPlots: TMenuItem; + SeqValues: TMenuItem; + MenuItem7: TMenuItem; + RandomVals: TMenuItem; + MenuItem8: TMenuItem; + MenuItem30: TMenuItem; + SaveFileBtn: TMenuItem; + Panel1: TPanel; + Panel2: TPanel; + DataGrid: TStringGrid; + procedure AboutClick(Sender: TObject); + procedure ABSAnovaClick(Sender: TObject); + procedure AncovaClick(Sender: TObject); + procedure AnovaClick(Sender: TObject); +// procedure AvgLinkClusterClick(Sender: TObject); + procedure AxSAnovaClick(Sender: TObject); + procedure BartlettTestClick(Sender: TObject); + procedure BinAClick(Sender: TObject); + procedure blockcopyClick(Sender: TObject); + procedure BlockPasteClick(Sender: TObject); + procedure BoxPlotClick(Sender: TObject); + procedure BreakdownClick(Sender: TObject); + procedure BubblePlotClick(Sender: TObject); + procedure CalculaterClick(Sender: TObject); + procedure ChiprobClick(Sender: TObject); + procedure CloseFileBtnClick(Sender: TObject); + procedure CompareDistsClick(Sender: TObject); + procedure CopyColClick(Sender: TObject); + procedure CopyRowClick(Sender: TObject); + procedure CorrDiffClick(Sender: TObject); + procedure CorrespondenceClick(Sender: TObject); + procedure CrossTabsClick(Sender: TObject); + procedure CSVFileInClick(Sender: TObject); + procedure CSVFileOutClick(Sender: TObject); + procedure CutColClick(Sender: TObject); + procedure CutRowClick(Sender: TObject); + procedure DataGridClick(Sender: TObject); + procedure DataGridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState + ); + procedure DataGridKeyPress(Sender: TObject; var Key: char); + procedure DataGridPrepareCanvas(sender: TObject; aCol, aRow: Integer; + aState: TGridDrawState); + procedure DataSmoothClick(Sender: TObject); + procedure DefineVarClick(Sender: TObject); + procedure DistPlotsClick(Sender: TObject); + procedure DistributionsClick(Sender: TObject); + procedure EquationClick(Sender: TObject); + procedure FormatGridClick(Sender: TObject); +// procedure FormClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure FprobClick(Sender: TObject); + procedure FreqAnalClick(Sender: TObject); + procedure GenKappaClick(Sender: TObject); + procedure GLMClick(Sender: TObject); + procedure GrdBkMnuClick(Sender: TObject); + procedure GridUseClick(Sender: TObject); + procedure GrpFreqClick(Sender: TObject); + procedure HelpContentsClick(Sender: TObject); + procedure homotestClick(Sender: TObject); + procedure HypergeoProbClick(Sender: TObject); + procedure InsNewColClick(Sender: TObject); + procedure inversezClick(Sender: TObject); + procedure ItemBankMenuItemClick(Sender: TObject); + procedure JPEGViewClick(Sender: TObject); + procedure KSTestClick(Sender: TObject); + procedure LatinSquaresClick(Sender: TObject); + procedure lifetableClick(Sender: TObject); + procedure LSMRitemClick(Sender: TObject); + procedure MatManMnuClick(Sender: TObject); + procedure MedianPolishClick(Sender: TObject); + procedure MenuItem100Click(Sender: TObject); + procedure MenuItem101Click(Sender: TObject); + procedure MenuItem102Click(Sender: TObject); + procedure MenuItem103Click(Sender: TObject); + procedure MenuItem104Click(Sender: TObject); + procedure MenuItem105Click(Sender: TObject); + procedure MenuItem106Click(Sender: TObject); + procedure MenuItem107Click(Sender: TObject); + procedure MenuItem108Click(Sender: TObject); + procedure MenuItem109Click(Sender: TObject); + procedure MenuItem10Click(Sender: TObject); + procedure MenuItem110Click(Sender: TObject); + procedure MenuItem111Click(Sender: TObject); + procedure MenuItem112Click(Sender: TObject); + procedure MenuItem113Click(Sender: TObject); + procedure MenuItem114Click(Sender: TObject); + procedure MenuItem115Click(Sender: TObject); + procedure MenuItem116Click(Sender: TObject); + procedure MenuItem117Click(Sender: TObject); + procedure MenuItem118Click(Sender: TObject); + procedure MenuItem119Click(Sender: TObject); + procedure MenuItem11Click(Sender: TObject); + procedure MenuItem120Click(Sender: TObject); + procedure MenuItem14Click(Sender: TObject); + procedure MenuItem16Click(Sender: TObject); + procedure MenuItem20Click(Sender: TObject); + procedure MenuItem27Click(Sender: TObject); + procedure MenuItem28Click(Sender: TObject); + procedure MenuItem29Click(Sender: TObject); + procedure MenuItem31Click(Sender: TObject); + procedure MenuItem33Click(Sender: TObject); + procedure MenuItem6Click(Sender: TObject); + procedure MenuItem71Click(Sender: TObject); + procedure MenuItem72Click(Sender: TObject); + procedure MenuItem73Click(Sender: TObject); + procedure MenuItem74Click(Sender: TObject); + procedure MenuItem75Click(Sender: TObject); + procedure MenuItem76Click(Sender: TObject); + procedure MenuItem77Click(Sender: TObject); + procedure MenuItem78Click(Sender: TObject); + procedure MenuItem79Click(Sender: TObject); + procedure MenuItem80Click(Sender: TObject); + procedure MenuItem81Click(Sender: TObject); + procedure MenuItem82Click(Sender: TObject); + procedure MenuItem83Click(Sender: TObject); + procedure MenuItem84Click(Sender: TObject); + procedure MenuItem85Click(Sender: TObject); + procedure MenuItem86Click(Sender: TObject); + procedure MenuItem87Click(Sender: TObject); + procedure MenuItem88Click(Sender: TObject); + procedure MenuItem89Click(Sender: TObject); + procedure MenuItem90Click(Sender: TObject); + procedure MenuItem91Click(Sender: TObject); + procedure MenuItem92Click(Sender: TObject); + procedure MenuItem93Click(Sender: TObject); + procedure MenuItem94Click(Sender: TObject); + procedure MenuItem95Click(Sender: TObject); + procedure MenuItem96Click(Sender: TObject); + procedure MenuItem97Click(Sender: TObject); + procedure MenuItem98Click(Sender: TObject); + procedure MenuItem99Click(Sender: TObject); + procedure MenuItem30Click(Sender: TObject); + procedure MultDistsClick(Sender: TObject); + procedure MultXvsYClick(Sender: TObject); + procedure NestedABCClick(Sender: TObject); + procedure NewFileBtnClick(Sender: TObject); + procedure NewRowClick(Sender: TObject); + procedure NormalityTestsClick(Sender: TObject); + procedure OneCaseAnovaClick(Sender: TObject); + procedure OneSampTestsClick(Sender: TObject); + procedure OpenFileBtnClick(Sender: TObject); + procedure OptionClick(Sender: TObject); + procedure PasteColClick(Sender: TObject); + procedure PasteRowClick(Sender: TObject); + procedure pcontrochartClick(Sender: TObject); +// procedure PicViewClick(Sender: TObject); + procedure PlotXvsYClick(Sender: TObject); + procedure PowerClick(Sender: TObject); + procedure PrintDefsClick(Sender: TObject); + procedure PrintGridClick(Sender: TObject); + procedure probgtzClick(Sender: TObject); + procedure ProbltzClick(Sender: TObject); + procedure probzbetweenClick(Sender: TObject); + procedure PropDiffClick(Sender: TObject); + procedure RandomValsClick(Sender: TObject); + procedure RecodeClick(Sender: TObject); + procedure ResistanceLineClick(Sender: TObject); + procedure RiditAnalysisClick(Sender: TObject); + procedure RunsTestClick(Sender: TObject); + procedure SaveFileBtnClick(Sender: TObject); + procedure ScatPlotClick(Sender: TObject); + procedure SelectCasesClick(Sender: TObject); + procedure SensClick(Sender: TObject); + procedure SeqValuesClick(Sender: TObject); + procedure SimpChiSqrClick(Sender: TObject); + procedure smoothClick(Sender: TObject); + procedure SortCasesClick(Sender: TObject); + procedure SRHItemClick(Sender: TObject); + procedure SSVFileInClick(Sender: TObject); + procedure SSVFileOutClick(Sender: TObject); + procedure StemLeafClick(Sender: TObject); + procedure StrToIntegersClick(Sender: TObject); + procedure SwapDecTypeClick(Sender: TObject); + procedure TabFileInBtnClick(Sender: TObject); + procedure ThreeDRotateClick(Sender: TObject); + procedure tprobClick(Sender: TObject); + procedure TransformClick(Sender: TObject); + procedure TTestsClick(Sender: TObject); + procedure TwoSLSRegClick(Sender: TObject); + procedure TypeErrorsClick(Sender: TObject); + procedure WghtedKappaClick(Sender: TObject); + procedure WithinAnovaClick(Sender: TObject); + procedure WLSRegClick(Sender: TObject); + procedure XvsMultYClick(Sender: TObject); + private + { private declarations } + procedure Init; + public + { public declarations } + end; + +var + OS3MainFrm: TOS3MainFrm; + PrevRow : integer; + PrevCol : integer; + +implementation + +{ TOS3MainFrm } + +uses + OptionsUnit, OutputUnit, LicenseUnit, TransFrmUnit, DescriptiveUnit, + FreqUnit, CrossTabUnit, BreakDownUnit, BoxPlotUnit, NormalityUnit, Rot3DUnit, + PlotXYUnit, BubblePlotUnit, StemLeafUnit, MultXvsYUnit, OneSampUnit, + TwoCorrsUnit, TwoPropUnit, TtestUnit, BlkAnovaUnit, WithinANOVAUnit, + AxSAnovaUnit, ABRAnovaUnit, ANCOVAUNIT, LatinSqrsUnit, RMatUnit, PartialsUnit, + AutoCorUnit, CanonUnit, GLMUnit, StepFwdMRUnit, BlkMRegUnit, BackRegUnit, + BestRegUnit, SimultRegUnit, CoxRegUnit, LogRegUnit, LinProUnit, DiscrimUnit, + FactorUnit, HierarchUnit, PathUnit, LogLinScreenUnit, TwoWayLogLinUnit, + ABCLogLinUnit, TestGenUnit, TestScoreUnit, RaschUnit, SuccIntUnit, GuttmanUnit, + CompRelUnit, KR21Unit, SpBrUnit, RelChangeUnit, DIFUnit, PolyDIFUnit, + ChiSqrUnit, SpearmanUnit, MannWhitUUnit, ExactUnit, ConcordanceUnit, + KWAnovaUnit, WilcoxonUnit, CochranQUnit, SignTestUnit, FriedmanUnit, + BinomialUnit, KendallTauUnit, KaplanMeierUnit, XBarUnit, RChartUnit, + SigmaChartUnit, CUMSUMUNIT, CCHARTUNIT, PChartUnit, UChartUnit, CorSimUnit, + ErrorCurvesUnit, PCurvesUnit, DistribUnit, GenSeqUnit, GenRndValsUnit, + MultGenUnit, LoanItUnit, SumYrsDepUnit, SLDUnit, DblDeclineUnit, + RIDITUnit, TwoSLSUnit, WLSUnit, HelpUnit, SortCasesUnit, + SelectCasesUnit, GridHelpUnit, RecodeUnit, KappaUnit, AvgLinkUnit, kmeansunit, + SingleLinkUnit, GenKappaUnit, CompareDistUnit, matmanunit, gradebookunit, + ProbzUnit, ProbSmallerzUnit, TwozProbUnit, InversezUnit, ProbChiSqrUnit, + TprobUnit, FProbUnit, HyperGeoUnit, BNestAUnit, ABCNestedUnit, BartlettTestUnit, + DataSmoothUnit, GroupFreqUnit, RunsTestUnit, XvsMultYUnit, SensUnit, + CorrespondenceUnit, EquationUnit, CalculatorUnit, JPEGUnit, ResistanceLineUnit, + MedianPolishUnit, OneCaseAnovaUnit, SmoothDataUnit, SRHTestUnit, AboutUnit, + ItemBankingUnit, ANOVATESTSUnit, SimpleChiSqrUnit, LifeTableUnit, LSMRunit; + +// Menu "Options" > "Exit" +procedure TOS3MainFrm.MenuItem16Click(Sender: TObject); +begin + SaveOptions; + TempStream.Free; + TempVarItm.Free; + Close; +end; + +procedure TOS3MainFrm.MenuItem20Click(Sender: TObject); +begin + SaveTabFile; +end; + +// Menu "Analysis" > "Financial" > "Double Declining Value" +procedure TOS3MainFrm.MenuItem27Click(Sender: TObject); +begin + if DblDeclineFrm = nil then + Application.CreateForm(TDblDeclineFrm, DblDeclineFrm); + DblDeclineFrm.ShowModal; +end; + +// Menu "Tools" > "Show Output Form" +procedure TOS3MainFrm.MenuItem28Click(Sender: TObject); +begin + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + OutputFrm.ShowModal; +end; + +// Menu" "Analysis" > "Multivariate" > "Average Link Clustering" +procedure TOS3MainFrm.MenuItem29Click(Sender: TObject); +begin + if AvgLinkFrm = nil then + Application.CreateForm(TAvgLinkFrm, AvgLinkFrm); + AvgLinkFrm.ShowModal; +end; + +// Menu "Analysis" > "Multivariate" > "K Means Clustering" +procedure TOS3MainFrm.MenuItem31Click(Sender: TObject); +begin + if KMeansFrm = nil then + Application.CreateForm(TKMeansFrm, KMeansFrm); + kmeansfrm.ShowModal; +end; + +// Menu "Analysis" > "Multivariate" > "Single Link Clustering" +procedure TOS3MainFrm.MenuItem33Click(Sender: TObject); +begin + if SingleLinkFrm = nil then + Application.CreateForm(TSingleLinkFrm, SingleLinkFrm); + SingleLinkFrm.ShowModal; +end; + +// Menu "Analysis" > "Statistical Process Control" > "CUMSUM Chart" +procedure TOS3MainFrm.MenuItem6Click(Sender: TObject); +begin + if CUMSUMFrm = nil then + Application.CreateForm(TCUMSUMFrm, CUMSUMFrm); + CUMSUMFrm.ShowModal; +end; + +procedure TOS3MainFrm.MenuItem71Click(Sender: TObject); +begin + if RMatFrm = nil then + Application.CreateForm(TRMatFrm, RMatFrm); + RMatFrm.ShowModal; +end; + +procedure TOS3MainFrm.MenuItem72Click(Sender: TObject); +begin + if PartialsFrm = nil then + Application.CreateForm(TPartialsFrm, PartialsFrm); + PartialsFrm.ShowModal; +end; + +procedure TOS3MainFrm.MenuItem73Click(Sender: TObject); +begin + if AutoCorrFrm = nil then + Application.CreateForm(TAutoCorrFrm, AutoCorrFrm); + AutocorrFrm.ShowModal; +end; + +procedure TOS3MainFrm.MenuItem74Click(Sender: TObject); +begin + if CannonFrm = nil then + Application.CreateForm(TCannonFrm, CannonFrm); + CannonFrm.ShowModal; +end; + +// Menu "Analysis" > "Multiple Regression" > "Forward Stepwise" +procedure TOS3MainFrm.MenuItem75Click(Sender: TObject); +begin + if StepFwdFrm = nil then + Application.CreateForm(TStepFwdFrm, StepFwdFrm); + StepFwdFrm.ShowModal; +end; + +// Menu "Analysis" > "Multiple Regression" > "Backward Stepwise" +procedure TOS3MainFrm.MenuItem76Click(Sender: TObject); +begin + if BackRegFrm = nil then + Application.CreateForm(TBackRegFrm, BackRegFrm); + BackRegFrm.ShowModal; +end; + +// Menu "Analysis" > "Multiple Regression" > "Simultaneous" +procedure TOS3MainFrm.MenuItem77Click(Sender: TObject); +begin + if SimultFrm = nil then + Application.CreateForm(TSimultFrm, SimultFrm); + SimultFrm.ShowModal; +end; + +procedure TOS3MainFrm.MenuItem78Click(Sender: TObject); +begin + if BlkMregFrm = nil then + Application.CreateForm(TBlkMregFrm, BlkMregFrm); + BlkMregFrm.ShowModal; +end; + +// Menu "Analysis" > "Multiple Regression" > "Best Combination" +procedure TOS3MainFrm.MenuItem79Click(Sender: TObject); +begin + if BestRegFrm = nil then + Application.CreateForm(TBestRegFrm, BestRegFrm); + BestRegFrm.ShowModal; +end; + +// Menu "Analysis" > "Multiple Regression" > "Binary Logistic" +procedure TOS3MainFrm.MenuItem80Click(Sender: TObject); +begin + if LogRegFrm = nil then + Application.CreateForm(TLogRegFrm, LogRegFrm); + LogRegFrm.ShowModal; +end; + +// Menu "Analysis" > "Multiple Regression" > "Cox Proportional Hazzards Survival Regression" +procedure TOS3MainFrm.MenuItem81Click(Sender: TObject); +begin + if CoxRegFrm = nil then + Application.CreateForm(TCoxRegFrm, CoxRegFrm); + CoxRegFrm.ShowModal; +end; + +// Menu "Analysis" > "Multiple Regression" > "Linear Programming" +procedure TOS3MainFrm.MenuItem82Click(Sender: TObject); +begin + if LinProFrm = nil then + Application.CreateForm(TLinProFrm, LinProFrm); + LinProFrm.ShowModal; +end; + +// Menu "Analysis" > "Multivariate" > "MANOVA / Discriminant Function" +procedure TOS3MainFrm.MenuItem83Click(Sender: TObject); +begin + if DiscrimFrm = nil then + Application.CreateForm(TDiscrimFrm, DiscrimFrm); + DiscrimFrm.ShowModal; +end; + +// Menu "Analysis" > "Multivariate" > "Hierarchical Analysis" +procedure TOS3MainFrm.MenuItem84Click(Sender: TObject); +begin + if HierarchFrm = nil then + Application.CreateForm(THierarchFrm, HierarchFrm); + HierarchFrm.ShowModal; +end; + +// Menu "Analysis" > "Multivariate" > "Path analysis" +procedure TOS3MainFrm.MenuItem85Click(Sender: TObject); +begin + if PathFrm = nil then + Application.CreateForm(TPathFrm, PathFrm); + PathFrm.ShowModal; +end; + +// Menu "Analysis" > "Multivariate" > "Factor analysis" +procedure TOS3MainFrm.MenuItem86Click(Sender: TObject); +begin + if FactorFrm = nil then + Application.CreateForm(TFactorFrm, FactorFrm); + FactorFrm.ShowModal; +end; + +procedure TOS3MainFrm.MenuItem87Click(Sender: TObject); +begin + if CannonFrm = nil then + Application.CreateForm(TCannonFrm, CannonFrm); + CannonFrm.ShowModal; +end; + +// Menu "Analysis" > "Multivariate" > "Generalized Kappa" +procedure TOS3MainFrm.MenuItem88Click(Sender: TObject); +begin + if GLMFrm = nil then + Application.CreateForm(TGLMFrm, GLMFrm); + GLMFrm.ShowModal; +end; + +// Menu "Analysis" > "Cross-classification" > "AxB Log Linear" +procedure TOS3MainFrm.MenuItem89Click(Sender: TObject); +begin + if TwoWayLogLinFrm = nil then + Application.CreateForm(TTwoWayLogLinFrm, TwoWayLogLinFrm); + TwoWayLogLinFrm.ShowModal; +end; + +// Menu "Analysis" > "Cross-Classification" > "AxBxC Log Linear" +procedure TOS3MainFrm.MenuItem90Click(Sender: TObject); +begin + if ABCLogLinearFrm = nil then + Application.CreateForm(TABCLogLinearFrm, ABCLogLinearFrm); + ABCLogLinearFrm.ShowModal; +end; + +// Menu "Analysis" > "Cross-classification" > "Log Linear Screen" +procedure TOS3MainFrm.MenuItem91Click(Sender: TObject); +begin + if LogLinScreenFrm = nil then + Application.CreateForm(TLogLinScreenFrm, LogLinScreenFrm); + LogLinScreenFrm.ShowModal; +end; + +// Menu "Analysis" > "Measurement Programs" > "Generate Sample Test Data" +procedure TOS3MainFrm.MenuItem92Click(Sender: TObject); +begin + if TestGenFrm = nil then + Application.CreateForm(TTestGenFrm, TestGenFrm); + TestGenFrm.ShowModal; +end; + +// Menu "Analysis" > "Measurement Programs" > "Classical Test Analysis" +procedure TOS3MainFrm.MenuItem93Click(Sender: TObject); +begin + if TestScoreFrm = nil then + Application.CreateForm(TTestScoreFrm, TestScoreFrm); + TestScoreFrm.Show; +end; + +// Menu "Analysis" > "Measurement Programs" > "Rasch Test Calibration" +procedure TOS3MainFrm.MenuItem94Click(Sender: TObject); +begin + if RaschFrm = nil then + Application.CreateForm(TRaschFrm, RaschFrm); + RaschFrm.ShowModal; +end; + +// Menu "Analysis" > "Measurement Programs" > "Successive Interval Scaling" +procedure TOS3MainFrm.MenuItem95Click(Sender: TObject); +begin + if SuccIntFrm = nil then + Application.CreateForm(TSuccIntFrm, SuccIntFrm); + SuccIntFrm.ShowModal; +end; + +// Menu "Analysis" > "Measurement Programs" > "Guttman Scalogram Analysis +procedure TOS3MainFrm.MenuItem96Click(Sender: TObject); +begin + if GuttmanFrm = nil then + Application.CreateForm(TGuttmanFrm, GuttmanFrm); + GuttmanFrm.ShowModal; +end; + +// Menu "Analysis" > "Measurement Programs" > "Weighted Composite Reliability" +procedure TOS3MainFrm.MenuItem97Click(Sender: TObject); +begin + if CompRelFrm = nil then + Application.CreateForm(TCompRelFrm, CompRelFrm); + CompRelFrm.ShowModal; +end; + +// Menu "Analysis" > "Measurement Programs" > "Kuder-Richardson #21 Reliability" +procedure TOS3MainFrm.MenuItem98Click(Sender: TObject); +begin + if KR21Frm = nil then + Application.CreateForm(TKR21Frm, KR21Frm); + KR21Frm.ShowModal; +end; + +// Menu "Analysis" > "Measurement Programs" > "Spearman-Brown Prophecy Reliability" +procedure TOS3MainFrm.MenuItem99Click(Sender: TObject); +begin + if SpBrFrm = nil then + Application.CreateForm(TSpBrFrm, SpBrFrm); + SpBrFrm.ShowModal; +end; + +// Menu "Simulations" > "Multivariate Distribution" +procedure TOS3MainFrm.MultDistsClick(Sender: TObject); +begin + if MultGenFrm = nil then + Application.CreateForm(TMultGenFrm, MultGenFrm); + MultGenFrm.ShowModal; +end; + +//Menu "Analysis" > "Descriptive" > "Multiple Group X vs Y Plot" +procedure TOS3MainFrm.MultXvsYClick(Sender: TObject); +begin + if MultXvsYFrm = nil then + Application.CreateForm(TMultXvsYFrm, MultXvsYFrm); + MultXvsYFrm.ShowModal; +end; + +// Menu "Analysis" > "Comparisons" > "ABC ANOVA with B Nested in A" +procedure TOS3MainFrm.NestedABCClick(Sender: TObject); +begin + if ABCNestedForm = nil then + Application.CreateForm(TABCNestedForm, ABCNestedForm); + ABCNestedForm.ShowModal; +end; + +procedure TOS3MainFrm.NewFileBtnClick(Sender: TObject); +begin + ClearGrid; +end; + +procedure TOS3MainFrm.NewRowClick(Sender: TObject); +begin + InsertRow; +end; + +// Menu "Analysis" > "Descriptive" > "Normality Tests" +procedure TOS3MainFrm.NormalityTestsClick(Sender: TObject); +begin + if NormalityFrm = nil then + Application.CreateForm(TNormalityFrm, NormalityFrm); + NormalityFrm.ShowModal; +end; + +// Menu "Analysis" > "Comparisons" > "2 or 3 Way ANOVA with One Case Per Cell" +procedure TOS3MainFrm.OneCaseAnovaClick(Sender: TObject); +begin + if OneCaseAnovaForm = nil then + Application.CreateForm(TOneCaseAnovaForm, OneCaseAnovaForm); + OneCaseAnovaForm.ShowModal; +end; + +// Menu "Analysis" > "One sample tests" +procedure TOS3MainFrm.OneSampTestsClick(Sender: TObject); +begin + if OneSampFrm = nil then + Application.CreateForm(TOneSampFrm, OneSampFrm); + OneSampFrm.ShowModal; +end; + +procedure TOS3MainFrm.OpenFileBtnClick(Sender: TObject); +{ +var + i : integer; + filename : string; + } +begin + OpenOS2File; + SaveOptions; + (* + filename := FileNameEdit.Text; + // move all down 1 and add new one at the top +{ for i := 8 downto 1 do + begin + MainMenu1.Items[0].Items[11].Items[i].Caption := + MainMenu1.Items[0].Items[11].Items[i-1].Caption; + MainMenu1.Items[0].Items[11].Items[i-1].Caption := ' '; + end; + MainMenu1.Items[0].Items[11].Items[0].Caption := filename;} + if OptionsFrm = nil then + Application.CreateForm(TOptionsFrm, OptionsFrm); + OptionsFrm.SaveBtnClick(Self); + *) +end; + +procedure TOS3MainFrm.OptionClick(Sender: TObject); +begin + with TOptionsFrm.Create(nil) do + try + ShowModal; + finally + Free; + end; + { + if OptionsFrm = nil then + Application.CreateForm(TOptionsFrm, OptionsFrm); + OptionsFrm.ShowModal; + } +end; + +procedure TOS3MainFrm.PasteColClick(Sender: TObject); +begin + PasteColumn; +end; + +procedure TOS3MainFrm.PasteRowClick(Sender: TObject); +begin + PasteARow; +end; + +// Menu "Analysis" > "Statistical Process Control" > "p Control Chart" +procedure TOS3MainFrm.pcontrochartClick(Sender: TObject); +begin + if pChartFrm = nil then + Application.CreateForm(TpChartFrm, pChartFrm); + pChartFrm.ShowModal; +end; + +// Menu "Analysis" > "Descriptive" > "Plot X vs Y" +procedure TOS3MainFrm.PlotXvsYClick(Sender: TObject); +begin + if PlotXYFrm = nil then + Application.CreateForm(TPlotXYFrm, PlotXYFrm); + PlotXYFrm.ShowModal; +end; + +// Menu "Simulations" > "Power Curves for a z test" +procedure TOS3MainFrm.PowerClick(Sender: TObject); +begin + if PCurvesFrm = nil then + Application.CreateForm(TPCurvesFrm, PCurvesFrm); + PCurvesFrm.ShowModal; +end; + +procedure TOS3MainFrm.PrintDefsClick(Sender: TObject); +begin + PrintDict; +end; + +procedure TOS3MainFrm.PrintGridClick(Sender: TObject); +begin + PrintData; +end; + +// Menu "Simulations" > "Probability > z" +procedure TOS3MainFrm.probgtzClick(Sender: TObject); +begin + if ProbzForm = nil then + Application.CreateForm(TProbZForm, ProbZForm); + ProbzForm.ShowModal; +end; + +// Menu "Simulations" > "Probability < z" +procedure TOS3MainFrm.ProbltzClick(Sender: TObject); +begin + if ProbSmallerZForm = nil then + Application.CreateForm(TProbSmallerZForm, ProbSmallerZForm); + ProbSmallerzForm.ShowModal; +end; + +// Menu "Simulations" > "Prob between 2 z values" +procedure TOS3MainFrm.probzbetweenClick(Sender: TObject); +begin + if TwoZProbForm = nil then + Application.CreateForm(TTwoZProbForm, TwoZProbForm); + TwozProbForm.ShowModal; +end; + +// Menu "Analysis" > "Comparisons" > "Difference beween Proportions" +procedure TOS3MainFrm.PropDiffClick(Sender: TObject); +begin + if TwoPropFrm = nil then + Application.CreateForm(TTwoPropFrm, TwoPropFrm); + TwoPropFrm.ShowModal; +end; + +// Menu "Simulations" > "Random Theoretical Values" +procedure TOS3MainFrm.RandomValsClick(Sender: TObject); +begin + if GenRndValsFrm = nil then + Application.CreateForm(TGenRndValsFrm, GenRndValsFrm); + GenRndValsFrm.ShowModal; +end; + +// Menu "Variables" > "Recode Variables" +procedure TOS3MainFrm.RecodeClick(Sender: TObject); +begin + if RecodeFrm = nil then + Application.CreateForm(TRecodeFrm, RecodeFrm); + RecodeFrm.ShowModal; +end; + +procedure TOS3MainFrm.ResistanceLineClick(Sender: TObject); +begin + if ResistanceLineForm = nil then + Application.CreateForm(TResistanceLineForm, ResistanceLineForm); + ResistanceLineForm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "RIDIT Analysis" +procedure TOS3MainFrm.RiditAnalysisClick(Sender: TObject); +begin + if RIDITFrm = nil then + Application.CreateForm(TRIDITFrm, RIDITFrm); + RIDITFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Runs Test for Normality" +procedure TOS3MainFrm.RunsTestClick(Sender: TObject); +begin + if RunsTestForm = nil then + Application.CreateForm(TRunsTestForm, RunsTestForm); + RunsTestForm.ShowModal; +end; + +procedure TOS3MainFrm.SaveFileBtnClick(Sender: TObject); +(* +var + i : integer; + filename : string; + *) +begin + SaveOS2File; + SaveOptions; + (* + filename := FileNameEdit.Text; + // move all down 1 and add new one at the top +{ for i := 8 downto 1 do + begin + MainMenu1.Items[0].Items[11].Items[i].Caption := + MainMenu1.Items[0].Items[11].Items[i-1].Caption; + MainMenu1.Items[0].Items[11].Items[i-1].Caption := ' '; + end; + MainMenu1.Items[0].Items[11].Items[0].Caption := filename;} + if OptionsFrm = nil then + Application.CreateForm(TOptionsFrm, OptionsFrm); + OptionsFrm.SaveBtnClick(Self); + *) +end; + +// Menu "Simulations" > "Bivariate Scatter Plot" +procedure TOS3MainFrm.ScatPlotClick(Sender: TObject); +begin + if CorSimFrm = nil then + Application.CreateForm(TCorSimFrm, CorSimFrm); + CorSimFrm.ShowModal; +end; + +// Menu "Tools" > "Select cases" +procedure TOS3MainFrm.SelectCasesClick(Sender: TObject); +begin + if SelectFrm = nil then + Application.CreateForm(TSelectFrm, SelectFrm); + SelectFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Sens's Slope Analysis" +procedure TOS3MainFrm.SensClick(Sender: TObject); +begin + if SensForm = nil then + Application.CreateForm(TSensForm, SensForm); + SensForm.ShowModal; +end; + +// Menu "Simulations" > "Generate Sequential Values" +procedure TOS3MainFrm.SeqValuesClick(Sender: TObject); +begin + if GenSeqFrm = nil then + Application.CreateForm(TGenSeqFrm, GenSeqFrm); + GenSeqFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Simple Chi Square for Categories" +procedure TOS3MainFrm.SimpChiSqrClick(Sender: TObject); +begin + if SimpleChiSqrForm = nil then + Application.CreateForm(TSimpleChiSqrForm, SimpleChiSqrForm); + SimpleChiSqrForm.ShowModal; +end; + +// Menu "Tools" > "Smooth Data in a Variable" +procedure TOS3MainFrm.smoothClick(Sender: TObject); +begin + if SmoothDataForm = nil then + Application.CreateForm(TSmoothDataForm, SmoothDataForm); + SmoothDataForm.ShowModal; +end; + +// Menu "Tools" > "Sort Cases" +procedure TOS3MainFrm.SortCasesClick(Sender: TObject); +begin + if SortCasesFrm = nil then + Application.CreateForm(TSortCasesFrm, SortCasesFrm); + SortCasesFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Schreier-Ray-Heart Two-Way ANOVA" +procedure TOS3MainFrm.SRHItemClick(Sender: TObject); +begin + if SRHTest = nil then + Application.CreateForm(TSRHTest, SRHTest); + SRHTest.ShowModal; +end; + +procedure TOS3MainFrm.SSVFileInClick(Sender: TObject); +begin + OpenSpaceFile; +end; + +procedure TOS3MainFrm.SSVFileOutClick(Sender: TObject); +begin + SaveSpaceFile; +end; + +// Menu "Analysis" > "Descriptive" > "Stem and Leaf Plot" +procedure TOS3MainFrm.StemLeafClick(Sender: TObject); +begin + if StemLeafFrm = nil then + Application.CreateForm(TStemLeafFrm, StemLeafFrm); + StemLeafFrm.ShowModal; +end; + +procedure TOS3MainFrm.StrToIntegersClick(Sender: TObject); +var + results, prompt: boolean; + col: integer; +begin + col := DataGrid.Col; + DataGrid.Row := 1; + prompt := true; + results := DataProcs.StringsToInt(col,col, prompt); + DataGrid.Col := col; + if not results then DeleteCol; +end; + +procedure TOS3MainFrm.SwapDecTypeClick(Sender: TObject); +var + i, j, k: integer; + newDecSep: Char; + cellStr: String; +begin + case Options.FractionType of + ftPoint: newDecSep := ','; // Current type is English - switch to European + ftComma: newDecSep := '.'; // Current type is European - switch to English + end; + + for i := 1 to DataGrid.RowCount-1 do + for j := 1 to DataGrid.ColCount - 1 do + begin + cellstr := DataGrid.Cells[j,i]; + for k := 1 to Length(cellStr) do + if cellstr[k] = DefaultFormatSettings.DecimalSeparator then + cellstr[k] := newDecSep; + DataGrid.Cells[j,i] := cellstr; + end; +end; + +procedure TOS3MainFrm.TabFileInBtnClick(Sender: TObject); +begin + OpenTabFile; +end; + +// Menu "Analysis" > "Descriptive" > "3-D Variable Rotation" +procedure TOS3MainFrm.ThreeDRotateClick(Sender: TObject); +begin + if Rot3DFrm = nil then + Application.CreateForm(TRot3DFrm, Rot3DFrm); + Rot3DFrm.ShowModal; +end; + +// Menu "Simulations" > "Student t probability" +procedure TOS3MainFrm.tprobClick(Sender: TObject); +begin + if TProbForm = nil then + Application.CreateForm(TTProbForm, TProbForm); + TprobForm.ShowModal; +end; + +// Menu "Variables" > "Transform Variables" +procedure TOS3MainFrm.TransformClick(Sender: TObject); +var + MyErrorString : string; +begin + try + if TransFrm = nil then + Application.CreateForm(TTransFrm, TransFrm); + TransFrm.ShowModal; + except +// MyErrorString := 'ErrorCode: ' + IntToStr(Error) + #13#10; + MyErrorString := 'Error in showing transformations'; + MessageDlg(MyErrorString , mtError, [mbOk], 0); + end; +end; + +// Menu "Analysis" > "Comparisons" > "t-tests" +procedure TOS3MainFrm.TTestsClick(Sender: TObject); +begin + if TTestFrm = nil then + Application.CreateForm(TTTestFrm, TTestFrm); + TTestFrm.ShowModal; +end; + +// Menu "Analysis" > "Multiple Regression" > "Two Stage Least Squares Regression" +procedure TOS3MainFrm.TwoSLSRegClick(Sender: TObject); +begin + if TwoSLSFrm = nil then + Application.CreateForm(TTwoSLSFrm, TwoSLSFrm); + TwoSLSFrm.ShowModal; +end; + +// Menu "Simulations" > "Type 1 and Type 2 Error Curves" +procedure TOS3MainFrm.TypeErrorsClick(Sender: TObject); +begin + if ErrorCurvesFrm = nil then + Application.CreateForm(TErrorCurvesFrm, ErrorCurvesFrm); + ErrorCurvesFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Kappa and Weighted Kappa" +procedure TOS3MainFrm.WghtedKappaClick(Sender: TObject); +begin + if WeightedKappaFrm = nil then + Application.CreateForm(TWeightedKappaFrm, WeightedKappaFrm); + WeightedKappaFrm.ShowModal; +end; + +// Menu "Analysis" > "Comparisons" > "Within Subjects ANOVA" +procedure TOS3MainFrm.WithinAnovaClick(Sender: TObject); +begin + if WithinANOVAFrm = nil then + Application.CreateForm(TWithinANOVAFrm, WithinANOVAFrm); + WithinAnovaFrm.ShowModal; +end; + +// Menu "Analysis" > "Multiple Regression" > "Weighted Least Squares Regression" +procedure TOS3MainFrm.WLSRegClick(Sender: TObject); +begin + if WLSFrm = nil then + Application.CreateForm(TWLSFrm, WLSFrm); + WLSFrm.ShowModal; +end; + +// Menu "Analysis" > "Descriptive" > "X versus Multiple Y Plot" +procedure TOS3MainFrm.XvsMultYClick(Sender: TObject); +begin + if XvsMultYForm = nil then + Application.CreateForm(TXvsMultYForm, XvsMultYForm); + XvsMultYForm.ShowModal; +end; + +procedure TOS3MainFrm.DefineVarClick(Sender: TObject); +begin + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); + DictionaryFrm.ShowModal; +end; + +// Menu "Simulations" > "Distribution Plots and Critical Values" +procedure TOS3MainFrm.DistPlotsClick(Sender: TObject); +begin + if DistribFrm = nil then + Application.CreateForm(TDistribFrm, DistribFrm); + DistribFrm.ShowModal; +end; + +// Menu "Analysis" > "Descriptive" > "Distribution Statistics" +procedure TOS3MainFrm.DistributionsClick(Sender: TObject); +begin + if DescriptiveFrm = nil then + Application.CreateForm(TDescriptiveFrm, DescriptiveFrm); + DescriptiveFrm.ShowModal; +end; + +// Menu "Variables" > "Equation Editor" +procedure TOS3MainFrm.EquationClick(Sender: TObject); +begin + if EquationForm = nil then + Application.CreateForm(TEquationForm, EquationForm); + EquationForm.ShowModal; +end; + +procedure TOS3MainFrm.FormatGridClick(Sender: TObject); +begin + DataProcs.FormatGrid; +end; + { +procedure TOS3MainFrm.FormClick(Sender: TObject); +begin + with TOptionsFrm.Create(nil) do + try + ShowModal; + finally + Free; + end; + (* + if OptionsFrm = nil then + Application.CreateForm(TOptionsFrm, OptionsFrm); + OptionsFrm.ShowModal; + *) +end; } + +procedure TOS3MainFrm.FormCreate(Sender: TObject); +begin + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); + + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + +(* if OptionsFrm = nil then + Application.CreateForm(TOptionsFrm, OptionsFrm); + *) +end; + +procedure TOS3MainFrm.DataGridKeyPress(Sender: TObject; var Key: char); +var + row, col : integer; +begin + NoVarsEdit.Text := IntToStr(DataGrid.ColCount-1); + if ord(Key) = 13 then exit; + col := DataGrid.Col; + row := DataGrid.Row; + if StrToInt(NoCasesEdit.Text) < row then + begin + NoCasesEdit.Text := IntToStr(row); + NoCases := row; + end; + if DataGrid.Cells[0,row] = '' then + begin + NoCases := row; + DataGrid.Cells[0,row] := 'CASE ' + IntToStr(row); + end; + if NoVariables < col then + begin + NoVariables := col; + end; + if ((PrevCol <> col) or (PrevRow <> row)) then + if DataGrid.Cells[PrevCol,PrevRow] <> '' then FormatCell(PrevCol,PrevRow); + PrevCol := col; + PrevRow := row; +end; + +procedure TOS3MainFrm.DataGridPrepareCanvas(sender: TObject; aCol, + aRow: Integer; aState: TGridDrawState); +var + ts: TTextStyle; + justif: String; +begin + ts := DataGrid.Canvas.TextStyle; + justif := DictionaryFrm.DictGrid.Cells[7, aCol]; + if justif = '' then justif := 'L'; + case justif[1] of + 'L': ts.Alignment := taLeftJustify; + 'C': ts.Alignment := taCenter; + 'R': ts.Alignment := taRightJustify; + end; + DataGrid.Canvas.Textstyle := ts; +end; + +// Menu "Analysis" > "Descriptive" > "Data Smoothing" +procedure TOS3MainFrm.DataSmoothClick(Sender: TObject); +begin + if DataSmoothingForm = nil then + Application.CreateForm(TDataSmoothingForm, DataSmoothingForm); + DataSmoothingForm.ShowModal; +end; + +procedure TOS3MainFrm.DataGridKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +var + x, y, v : integer; + +begin + x := DataGrid.Row; + y := DataGrid.Col; + v := ord(Key); + + case v of + 13 : begin // return key + if y =DataGrid.ColCount - 1 then + begin +{ DataGrid.ColCount := DataGrid.ColCount + 1; + DataGrid.Col := y + 1;} + end; + end; + 40 : begin // arrow down + if x =DataGrid.RowCount - 1 then + begin + DataGrid.RowCount := DataGrid.RowCount + 1; + DataGrid.Cells[0,x+1] := 'CASE ' + IntToStr(x+1); + NoCasesEdit.Text := IntToStr(x+1); + NoCases := DataGrid.RowCount - 1; + DataGrid.SetFocus; + end; + end; + end; + RowEdit.Text := IntToStr(DataGrid.RowCount - 1); + ColEdit.Text := IntToStr(DataGrid.ColCount - 1); + if ((PrevCol <> y) or (PrevRow <> x)) then + if DataGrid.Cells[PrevCol,PrevRow] <> '' then FormatCell(PrevCol,PrevRow); +end; + +procedure TOS3MainFrm.CSVFileInClick(Sender: TObject); +begin + OpenCommaFile; +end; + +procedure TOS3MainFrm.CloseFileBtnClick(Sender: TObject); +begin + NoCases := 0; + NoVariables := 0; + Init; + DataGrid.Cells[1, 0] := ''; +end; + +// Menu "Analysis" > "Descriptive" > "Compare Distributions" +procedure TOS3MainFrm.CompareDistsClick(Sender: TObject); +begin + if CompareDistFrm = nil then + Application.CreateForm(TCompareDistFrm, CompareDistFrm); + CompareDistFrm.ShowModal; +end; + +// Menu "Analysis" > "Descriptive" > "Breakdown" +procedure TOS3MainFrm.BreakdownClick(Sender: TObject); +begin + if BreakDownFrm = nil then + Application.CreateForm(TBreakDownFrm, BreakDownFrm); + BreakDownFrm.ShowModal; +end; + +// Menu "Analysis" > "Descriptive" > "Repeated Measures Bubble Plot" +procedure TOS3MainFrm.BubblePlotClick(Sender: TObject); +begin + if BubbleForm = nil then + Application.CreateForm(TBubbleForm, BubbleForm); + BubbleForm.ShowModal; +end; + +// Menu "Tools" > "Calculator" +procedure TOS3MainFrm.CalculaterClick(Sender: TObject); +begin + if CalculatorForm = nil then + Application.CreateForm(TCalculatorForm, CalculatorForm); + CalculatorForm.ShowModal; +end; + +// Menu "Simulations" > "Chisquare Probability" +procedure TOS3MainFrm.ChiprobClick(Sender: TObject); +begin + if ChiSqrProbForm = nil then + Application.CreateForm(TChiSqrProbForm, ChiSqrProbForm); + ChiSqrProbForm.ShowModal; +end; + +// Menu "Analysis" > "Descriptive" > "Box Plot" +procedure TOS3MainFrm.BoxPlotClick(Sender: TObject); +begin + if BoxPlotFrm = nil then + Application.CreateForm(TBoxPlotFrm, BoxPlotFrm); + BoxPlotFrm.ShowModal; +end; + +// Menu "Analysis" > "Comparisons" > "1,2 or 3 Way ANOVAs" +procedure TOS3MainFrm.AnovaClick(Sender: TObject); +begin + if BlksAnovaFrm = nil then + Application.CreateForm(TBlksAnovaFrm, BlksAnovaFrm); + BlksAnovaFrm.ShowModal; +end; + +// Menu "Analysis" > "Comparisons" > "A x B x S ANOVA" +procedure TOS3MainFrm.ABSAnovaClick(Sender: TObject); +begin + if ABRAnovaFrm = nil then + Application.CreateForm(TABRAnovaFrm, ABRAnovaFrm); + ABRAnovaFrm.ShowModal; +end; + +// Menu "Help" > "About" +procedure TOS3MainFrm.AboutClick(Sender: TObject); +begin + ShowAboutBox; +// ShowMessage('Copyright November 1, 2011 by Bill Miller'); +end; + +// Menu "Analysis" > "Comparisons" > "ANCOVA by Regression" +procedure TOS3MainFrm.AncovaClick(Sender: TObject); +begin + if ANCOVAfrm = nil then + Application.CreateForm(TANCOVAfrm, ANCOVAfrm); + ANCOVAFRM.ShowModal; +end; + +// Menu "Analysis" > "Comparisons" > "A x S ANOVA" +procedure TOS3MainFrm.AxSAnovaClick(Sender: TObject); +begin + if AxSAnovaFrm = nil then + Application.CreateForm(TAxSAnovaFrm, AxSAnovaFrm); + AxSAnovaFrm.ShowModal; +end; + +// Menu "Analysis" > "Multivariate" > "Bartlett Test of Sphericity" +procedure TOS3MainFrm.BartlettTestClick(Sender: TObject); +begin + if BartlettTestForm = nil then + Application.CreateForm(TBartlettTestForm, BartlettTestform); + BartlettTestForm.ShowModal; +end; + +// Menu "Analysis" > "Comparisons" > "B Nested in A ANOVA" +procedure TOS3MainFrm.BinAClick(Sender: TObject); +begin + if BNestedAForm = nil then + Application.CreateForm(TBNestedAForm, BNestedAForm); + BNestedAForm.ShowModal; +end; + +procedure TOS3MainFrm.blockcopyClick(Sender: TObject); +begin + CopyIt; +end; + +procedure TOS3MainFrm.BlockPasteClick(Sender: TObject); +begin + PasteIt; +end; + +procedure TOS3MainFrm.CopyColClick(Sender: TObject); +begin + CopyColumn; +end; + +procedure TOS3MainFrm.CopyRowClick(Sender: TObject); +begin + CopyaRow; +end; + +// Menu "Analysis" > "Comparisons" > "Difference Between Correlations" +procedure TOS3MainFrm.CorrDiffClick(Sender: TObject); +begin + if TwoCorrsFrm = nil then + Application.CreateForm(TTwoCorrsFrm, TwoCorrsFrm); + TwoCorrsFrm.ShowModal; +end; + +// Menu "Analysis" > "Multivariate" > "Correspondence Analysis" +procedure TOS3MainFrm.CorrespondenceClick(Sender: TObject); +begin + if CorrespondenceForm = nil then + Application.CreateForm(TCorrespondenceForm, CorrespondenceForm); + CorrespondenceForm.ShowModal; +end; + +// Menu "Analysis" > "Descriptive" > "Cross tabulation" +procedure TOS3MainFrm.CrossTabsClick(Sender: TObject); +begin + if CrossTabFrm = nil then + Application.CreateForm(TCrossTabFrm, CrossTabFrm); + CrossTabFrm.ShowModal; +end; + +procedure TOS3MainFrm.CSVFileOutClick(Sender: TObject); +begin + SaveCommaFile; +end; + +procedure TOS3MainFrm.CutColClick(Sender: TObject); +begin + DeleteCol; +end; + +procedure TOS3MainFrm.CutRowClick(Sender: TObject); +begin + CutaRow; +end; + +procedure TOS3MainFrm.DataGridClick(Sender: TObject); +VAR row, col : integer; +begin + row := DataGrid.Row; + col := DataGrid.Col; + RowEdit.Text := IntToStr(row); + ColEdit.Text := IntToStr(col); +end; + +procedure TOS3MainFrm.FormShow(Sender: TObject); +begin + Init; + if ParamCount > 0 then begin + OpenOS2File(ParamStr(1), false); + NoVarsEdit.Text := IntToStr(DataGrid.ColCount-1); + NoCasesEdit.Text := IntToStr(DataGrid.RowCount-1); + end; +end; + +procedure TOS3MainFrm.Init; +var + i: integer; +begin + OpenStatPath := GetCurrentDir; +// OptionsFrm.InitOptions(Self); + NoVariables := 0; // global variable for no. of variables (columns) + NoCases := 0; // global variable for no. of cases (rows) + TempStream := TMemoryStream.Create; // global variable (simulate clipboard) + TempVarItm := TMemoryStream.Create; // global var. for dictionary clips + FilterOn := false; // global variable = true when a filter variable selected + DictLoaded := false; // global variable = true when a dictionary file read + RowEdit.Text := '1'; + ColEdit.Text := '1'; + FileNameEdit.Text := 'TempFile.TAB'; + FilterEdit.Text := 'OFF'; + DataGrid.RowCount := 2; + DataGrid.ColCount := 2; + DataGrid.Cells[0,0] := 'CASE/VAR.'; + DataGrid.Cells[0,1] := 'CASE ' + IntToStr(1); + DataGrid.Cells[1,1] := ''; + PrevRow := 1; + PrevCol := 1; + NoCasesEdit.Text := '0'; + NoVarsEdit.Text := '0'; + DictionaryFrm.DictGrid.RowCount := DictionaryFrm.DictGrid.FixedRows; + for i := 1 to 500 do + VarDefined[i] := false; + + DictionaryFrm.Init; + { + DictionaryFrm.Show; + DictionaryFrm.ReturnBtnClick(self) ; + DictionaryFrm.Hide; + } + + NoVarsEdit.Text := IntToStr(DataGrid.ColCount-1); + NoCasesEdit.Text := IntToStr(DataGrid.RowCount-1); +end; + +// Menu "Simulations" > "F probability" +procedure TOS3MainFrm.FprobClick(Sender: TObject); +begin + if FForm = nil then + Application.CreateForm(TFForm, FForm); + FForm.ShowModal; +end; + +// Menu "Analysis" > "Descriptive" > "Frequency Analysis" +procedure TOS3MainFrm.FreqAnalClick(Sender: TObject); +begin + if FreqFrm = nil then + Application.CreateForm(TFreqFrm, FreqFrm); + FreqFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Generalized Kappa" +procedure TOS3MainFrm.GenKappaClick(Sender: TObject); +begin + if GenKappaFrm = nil then + Application.CreateForm(TGenKappaFrm, GenKappaFrm); + GenKappaFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "General Linear Model" +procedure TOS3MainFrm.GLMClick(Sender: TObject); +begin + if GLMFrm = nil then + Application.CreateForm(TGLMFrm, GLMFrm); + GLMFrm.ShowModal; +end; + +// Menu "Analysis" > "Measurement Programs" > "Grade Book" +procedure TOS3MainFrm.GrdBkMnuClick(Sender: TObject); +begin + if GradeBookFrm = nil then + Application.CreateForm(TGradeBookFrm, GradeBookFrm); + GradebookFrm.ShowModal; +end; + +procedure TOS3MainFrm.GridUseClick(Sender: TObject); +begin + if GridHelpfrm = nil then + Application.CreateForm(TGridHelpFrm, GridHelpFrm); + GridHelpFrm.ShowModal; +end; + +// Menu "Analysis" > "Descriptive" > "Plot Group Frequencies" +procedure TOS3MainFrm.GrpFreqClick(Sender: TObject); +begin + if GroupFreqForm = nil then + Application.CreateForm(TGroupFreqForm, GroupFreqForm); + GroupFreqForm.ShowModal; +end; + +// Menu "Help" > "General Help" +procedure TOS3MainFrm.HelpContentsClick(Sender: TObject); +begin + if HelpFrm = nil then + Application.CreateForm(THelpFrm, HelpFrm); + HelpFrm.ShowModal; +end; + +// Menu "Analyses" > "Brown-Forsythe test for homogeneity of variance" +procedure TOS3MainFrm.homotestClick(Sender: TObject); +Var + response : string; + GroupCol, VarColumn,NoCases : integer; +begin + response := InputBox('Column no. of group codes:','Column?','1'); + GroupCol := StrToInt(response); + response := InputBox('Column no. of dependent variable:','Column','2'); + VarColumn := StrToInt(response); + NoCases := StrToInt(NoCasesEdit.text); + HomogeneityTest(GroupCol, VarColumn, NoCases); +end; + +// Menu "Simulations" > "Hypergeometric probability" +procedure TOS3MainFrm.HypergeoProbClick(Sender: TObject); +begin + if HyperGeoForm = nil then + Application.CreateForm(THyperGeoForm, HyperGeoForm); + HyperGeoForm.ShowModal; +end; + +procedure TOS3MainFrm.InsNewColClick(Sender: TObject); +begin + InsertCol; +end; + +// Menu "Simulations" > "z for a given cum. Probability" +procedure TOS3MainFrm.InverseZClick(Sender: TObject); +begin + if InverseZForm = nil then + Application.CreateForm(TInverseZForm, InverseZForm); + InverseZForm.ShowModal; +end; + +// Menu "Analysis" > "Measurement Programs" > "Item Banking" +procedure TOS3MainFrm.ItemBankMenuItemClick(Sender: TObject); +begin + if ItemBankFrm = nil then + Application.CreateForm(TItemBankFrm, ItembankFrm); + ItemBankFrm.ShowModal; +end; + +// Menu "Tools" > "JPEG Image Viewer" +procedure TOS3MainFrm.JPEGViewClick(Sender: TObject); +begin + if JPEGForm = nil then + Application.CreateForm(TJPEGForm, JPEGForm); + JPEGForm.ShowModal; +end; + +procedure TOS3MainFrm.KSTestClick(Sender: TObject); +begin + if CompareDistFrm = nil then + Application.CreateForm(TCompareDistFrm, CompareDistFrm); + CompareDistFrm.ShowModal; +end; + +// Menu "Analysis" > "Comparisons" > "Latin and Greco-Latin Squares" +procedure TOS3MainFrm.LatinSquaresClick(Sender: TObject); +begin + if LatinSqrsFrm = nil then + Application.CreateForm(TLatinSqrsFrm, LatinSqrsFrm); + LatinSqrsFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Life table" +procedure TOS3MainFrm.lifetableClick(Sender: TObject); +begin + if LifeTableForm = nil then + Application.CreateForm(TLifeTableForm, LifeTableForm); + LifeTableForm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Least Squares Multiple Regression" +procedure TOS3MainFrm.LSMRitemClick(Sender: TObject); +begin + if LSMRegForm = nil then + Application.CreateForm(TLSMregForm, LSMregForm); + LSMregForm.ShowModal; +end; + +procedure TOS3MainFrm.MatManMnuClick(Sender: TObject); +begin + if MatManFrm = nil then + Application.CreateForm(TMatManFrm, MatManFrm); + MatManFrm.ShowModal; +end; + +// Menu "Analysis" > "Multivariate" > "Median Polishing for a 2x2 Table". +procedure TOS3MainFrm.MedianPolishClick(Sender: TObject); +begin + if MedianPolishForm = nil then + Application.CreateForm(TMedianPolishForm, MedianPolishForm); + MedianPolishForm.ShowModal; +end; + +// Menu "Analysis" > "Measurement Programs" > "Reliability Due to Test Variance Change" +procedure TOS3MainFrm.MenuItem100Click(Sender: TObject); +begin + if RelChangeFrm = nil then + Application.CreateForm(TRelChangeFrm, RelChangeFrm); + RelChangeFrm.ShowModal; +end; + +// Menu "Analysis" > "Measurement Programs" > "Differential Item Functioning" +procedure TOS3MainFrm.MenuItem101Click(Sender: TObject); +begin + if DIFFrm = nil then + Application.CreateForm(TDIFFrm, DIFFrm); + DIFFrm.ShowModal; +end; + +// Menu "Analysis" > "Measurement Programs" > "Polytomous DIF Analysis" +procedure TOS3MainFrm.MenuItem102Click(Sender: TObject); +begin + if PolyDIFFrm = nil then + Application.CreateForm(TPolyDIFFrm, PolyDIFFrm); + PolyDIFFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Contingency Chi Square" +procedure TOS3MainFrm.MenuItem103Click(Sender: TObject); +begin + if ChiSqrFrm = nil then + Application.CreateForm(TChiSqrFrm, ChiSqrFrm); + ChiSqrFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Spearman Rank Correlation" +procedure TOS3MainFrm.MenuItem104Click(Sender: TObject); +begin + if SpearmanFrm = nil then + Application.CreateForm(TSpearmanFrm, SpearmanFrm); + SpearmanFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Mann-Whitney U Test" +procedure TOS3MainFrm.MenuItem105Click(Sender: TObject); +begin + if MannWhitUFrm = nil then + Application.CreateForm(TMannWhitUFrm, MannWhitUFrm); + MannWhitUFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Fisher's Exact Text" +procedure TOS3MainFrm.MenuItem106Click(Sender: TObject); +begin + if FisherFrm = nil then + Application.CreateForm(TFisherFrm, FisherFrm); + FisherFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Kendall's Coefficient of Concordance" +procedure TOS3MainFrm.MenuItem107Click(Sender: TObject); +begin + if ConcordFrm = nil then + Application.CreateForm(TConcordFrm, ConcordFrm); + ConcordFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Kruskal-Wallis One-Way ANOVA" +procedure TOS3MainFrm.MenuItem108Click(Sender: TObject); +begin + if KWAnovaFrm = nil then + Application.CreateForm(TKWAnovaFrm, KWAnovaFrm); + KWAnovaFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Matched Pairs Signed Ranks Test" +procedure TOS3MainFrm.MenuItem109Click(Sender: TObject); +begin + if WilcoxonFrm = nil then + Application.CreateForm(TWilcoxonFrm, WilcoxonFrm); + WilcoxonFrm.ShowModal; +end; + +// Menu "Analysis" > "Financial" > "Loan Amortization Schedule" +procedure TOS3MainFrm.MenuItem10Click(Sender: TObject); +begin + if LoanItFrm = nil then + Application.CreateForm(TLoanItFrm, LoanItFrm); + LoanItFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Cochran Q Test" +procedure TOS3MainFrm.MenuItem110Click(Sender: TObject); +begin + if CochranQFrm = nil then + Application.CreateForm(TCochranQFrm, CochranQFrm); + CochranQFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Sign Test" +procedure TOS3MainFrm.MenuItem111Click(Sender: TObject); +begin + if SignTestFrm = nil then + Application.CreateForm(TSignTestFrm, SignTestFrm); + SignTestFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Friedman Two-Way ANOVA" +procedure TOS3MainFrm.MenuItem112Click(Sender: TObject); +begin + if FriedmanFrm = nil then + Application.CreateForm(TFriedmanFrm, FriedmanFrm); + FriedmanFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Probability of a Binomial Event" +procedure TOS3MainFrm.MenuItem113Click(Sender: TObject); +begin + if BinomialFrm = nil then + Application.CreateForm(TBinomialFrm, BinomialFrm); + BinomialFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > Kendall's Tau and Partial Tau" +procedure TOS3MainFrm.MenuItem114Click(Sender: TObject); +begin + if KendallTauFrm = nil then + Application.CreateForm(TKendallTauFrm, KendallTauFrm); + KendallTauFrm.ShowModal; +end; + +// Menu "Analysis" > "Nonparametric" > "Kaplan-Meier Survival Analysis" +procedure TOS3MainFrm.MenuItem115Click(Sender: TObject); +begin + if KaplanMeierFrm = nil then + Application.CreateForm(TKaplanMeierFrm, KaplanMeierFrm); + KaplanMeierFrm.ShowModal; +end; + +// Menu "Analysis" > "Statistical Process Control" > "XBAR Chart" +procedure TOS3MainFrm.MenuItem116Click(Sender: TObject); +begin + if XBarFrm = nil then + Application.CreateForm(TXBarFrm, XBarFrm); + XBarFrm.ShowModal; +end; + +// Menu "Analysis" > "Statistical Process Control" > "Range Chart" +procedure TOS3MainFrm.MenuItem117Click(Sender: TObject); +begin + if RChartFrm = nil then + Application.CreateForm(TRChartFrm, RChartFrm); + RChartFrm.ShowModal; +end; + +// Menu "Analysis" > "Statistical Process Control" > "S Control Chart" +procedure TOS3MainFrm.MenuItem118Click(Sender: TObject); +begin + if SigmaChartFrm = nil then + Application.CreateForm(TSigmaChartFrm, SigmaChartFrm); + SigmaChartFrm.ShowModal; +end; + +// Menu "Analysis" > "Statistical Process Control" > "Defect (nonconformity) c Chart" +procedure TOS3MainFrm.MenuItem119Click(Sender: TObject); +begin + if CChartFrm = nil then + Application.CreateForm(TCChartFrm, CChartFrm); + CChartFrm.ShowModal; +end; + +// Menu "Analysis" > "Financial" > "Sum of years digits depreciation" +procedure TOS3MainFrm.MenuItem11Click(Sender: TObject); +begin + if SumYrsDepFrm = nil then + Application.CreateForm(TSumYrsDepFrm, SumYrsDepFrm); + SumYrsDepFrm.ShowModal; +end; + +// Menu "Analysis" > "Statistical Process Control" > "Defects per Unit u Chart" +procedure TOS3MainFrm.MenuItem120Click(Sender: TObject); +begin + if UChartFrm = nil then + Application.CreateForm(TUChartFrm, UChartFrm); + UChartFrm.ShowModal; +end; + +// Menu "Analysis" > "Financial" > "Straight line depreciation" +procedure TOS3MainFrm.MenuItem14Click(Sender: TObject); +begin + if SLDepFrm = nil then + Application.CreateForm(TSLDepFrm, SLDepFrm); + SLDepFrm.ShowModal; +end; + +procedure TOS3MainFrm.MenuItem30Click(Sender: TObject); +begin + RowColSwap; +end; + +initialization + {$I mainunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/misc/blankfrmunit.lfm b/applications/lazstats/source/forms/misc/blankfrmunit.lfm new file mode 100644 index 000000000..39b5f904b --- /dev/null +++ b/applications/lazstats/source/forms/misc/blankfrmunit.lfm @@ -0,0 +1,102 @@ +object BlankFrm: TBlankFrm + Left = 442 + Height = 557 + Top = 204 + Width = 751 + ActiveControl = CloseBtn + BorderStyle = bsSingle + Caption = 'BlankFrm' + ClientHeight = 557 + ClientWidth = 751 + OnActivate = FormActivate + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Image1: TImage + Left = 8 + Height = 499 + Top = 8 + Width = 735 + Align = alClient + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + end + object Panel1: TPanel + Left = 8 + Height = 26 + Top = 523 + Width = 735 + Align = alBottom + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 26 + ClientWidth = 735 + TabOrder = 0 + object PrintBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 342 + Height = 25 + Top = 1 + Width = 51 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Right = 12 + Caption = 'Print' + OnClick = PrintBtnClick + TabOrder = 1 + end + object SaveBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = PrintBtn + Left = 244 + Height = 25 + Top = 1 + Width = 86 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Save Image' + OnClick = SaveBtnClick + TabOrder = 0 + end + object CloseBtn: TButton + AnchorSideLeft.Control = PrintBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Side = asrBottom + Left = 405 + Height = 25 + Top = 1 + Width = 55 + AutoSize = True + Caption = 'Close' + OnClick = CloseBtnClick + TabOrder = 2 + end + end + object Bevel1: TBevel + Left = 0 + Height = 8 + Top = 507 + Width = 751 + Align = alBottom + Shape = bsBottomLine + end + object SavePictureDialog1: TSavePictureDialog + left = 120 + top = 392 + end + object OpenPictureDialog1: TOpenPictureDialog + left = 248 + top = 392 + end + object PrintDialog1: TPrintDialog + left = 376 + top = 392 + end +end diff --git a/applications/lazstats/source/forms/misc/blankfrmunit.pas b/applications/lazstats/source/forms/misc/blankfrmunit.pas new file mode 100644 index 000000000..4aaea1fc0 --- /dev/null +++ b/applications/lazstats/source/forms/misc/blankfrmunit.pas @@ -0,0 +1,102 @@ +unit BlankFrmUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, PrintersDlgs, LResources, Forms, Controls, + Graphics, Dialogs, ExtCtrls, StdCtrls, ExtDlgs, Clipbrd, Printers; + +type + + { TBlankFrm } + + TBlankFrm = class(TForm) + Bevel1: TBevel; + PrintDialog1: TPrintDialog; + SaveBtn: TButton; + PrintBtn: TButton; + CloseBtn: TButton; + OpenPictureDialog1: TOpenPictureDialog; + Image1: TImage; + Panel1: TPanel; + SavePictureDialog1: TSavePictureDialog; + procedure CloseBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure PrintBtnClick(Sender: TObject); + procedure SaveBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + BlankFrm: TBlankFrm; + +implementation + +uses + Math; + +{ TBlankFrm } + +procedure TBlankFrm.CloseBtnClick(Sender: TObject); +begin +// Bitmap.FreeImage; + Close; +end; + +procedure TBlankFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([SaveBtn.Width, PrintBtn.Width, CloseBtn.Width]); + SaveBtn.Constraints.MinWidth := w; + PrintBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; +end; + +procedure TBlankFrm.FormShow(Sender: TObject); +begin +// Image1.Canvas.Clear; +// Bitmap := GetFormImage; +// Clipboard.Assign(Bitmap); +// Image1.Picture.Assign(Clipboard); +end; + +procedure TBlankFrm.PrintBtnClick(Sender: TObject); +var + r: Trect; +begin + if not PrintDialog1.Execute then + exit; + + with Printer do + begin + Printer.Orientation := poPortrait; + r := Rect(20,20,printer.pagewidth-20,printer.pageheight div 2 + 20); + BeginDoc; + try + Canvas.StretchDraw(r,Image1.Picture.BitMap); + finally + EndDoc; + end; + end; +end; + +procedure TBlankFrm.SaveBtnClick(Sender: TObject); +begin + if SavePictureDialog1.Execute then + begin + Image1.Picture.SaveToFile(SavePictureDialog1.FileName); + end; +end; + +initialization + {$I blankfrmunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/misc/contexthelpunit.lfm b/applications/lazstats/source/forms/misc/contexthelpunit.lfm new file mode 100644 index 000000000..51e212070 --- /dev/null +++ b/applications/lazstats/source/forms/misc/contexthelpunit.lfm @@ -0,0 +1,61 @@ +object ContextHelpForm: TContextHelpForm + Left = 240 + Height = 404 + Top = 134 + Width = 578 + Caption = 'Contextual Help' + ClientHeight = 404 + ClientWidth = 578 + Position = poScreenCenter + LCLVersion = '2.1.0.0' + object Panel1: TPanel + Left = 8 + Height = 26 + Top = 370 + Width = 562 + Align = alBottom + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 26 + ClientWidth = 562 + TabOrder = 0 + object Button1: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideBottom.Side = asrBottom + Left = 244 + Height = 25 + Top = 1 + Width = 75 + Caption = 'OK' + Constraints.MinWidth = 75 + Default = True + ModalResult = 1 + OnClick = Button1Click + TabOrder = 0 + end + end + object Memo1: TMemo + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + Left = 8 + Height = 354 + Top = 8 + Width = 562 + Align = alClient + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Lines.Strings = ( + 'Memo1' + ) + ScrollBars = ssVertical + TabOrder = 1 + end +end diff --git a/applications/lazstats/source/forms/misc/contexthelpunit.pas b/applications/lazstats/source/forms/misc/contexthelpunit.pas new file mode 100644 index 000000000..17aa79a83 --- /dev/null +++ b/applications/lazstats/source/forms/misc/contexthelpunit.pas @@ -0,0 +1,70 @@ +unit ContextHelpUnit; + +{$mode objfpc} +{$H+} + +interface + +uses + IniFiles, Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, + Dialogs, ExtCtrls, StdCtrls; + +type + + { TContextHelpForm } + + TContextHelpForm = class(TForm) + Button1: TButton; + Memo1: TMemo; + Panel1: TPanel; + procedure Button1Click(Sender: TObject); + private + { private declarations } + public + { public declarations } + procedure HelpMessage(lTag: integer); + end; + +var + ContextHelpForm: TContextHelpForm; + +implementation + +function ReadIniFileTag(var lTag: Integer): string; +//Read string with index lTag +var + lIniFile: TIniFile; + lFilename,lLang: string; +begin + lFilename := changefileext(paramstr(0),'.ini'); + if (not Fileexists(lFilename)) then begin + result := 'No contextual help: unable to find '+lFilename; + exit; + end; + result := 'No contextual help found for '+IntToStr(lTag); + lIniFile := TIniFile.Create(lFilename); + try + lLang := lIniFile.ReadString('LANGUAGE', 'DEFAULT', ''); + result := lIniFile.ReadString(lLang, IntToStr(lTag), result); + finally + lIniFile.Free; + end; +end; + +procedure TContextHelpForm.Button1Click(Sender: TObject); +begin + Close; +end; + +procedure TContextHelpForm.HelpMessage(lTag: integer); +begin + Memo1.Lines.Clear; + Memo1.lines.Add(ReadIniFileTag(lTag)); + ContextHelpForm.Show; +end; + +initialization + {$I contexthelpunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/misc/dictionaryunit.lfm b/applications/lazstats/source/forms/misc/dictionaryunit.lfm new file mode 100644 index 000000000..be460e850 --- /dev/null +++ b/applications/lazstats/source/forms/misc/dictionaryunit.lfm @@ -0,0 +1,237 @@ +object DictionaryFrm: TDictionaryFrm + Left = 389 + Height = 501 + Top = 153 + Width = 701 + Caption = 'Dictionary Form' + ClientHeight = 501 + ClientWidth = 701 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = TypeCombo + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 12 + Width = 336 + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + Caption = 'Note: Pressing the down arrow key will add a new row (variable)' + ParentColor = False + end + object DictGrid: TStringGrid + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = HelpBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Splitter1 + Left = 12 + Height = 260 + Top = 76 + Width = 677 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 12 + BorderSpacing.Top = 12 + BorderSpacing.Right = 12 + ColCount = 7 + MouseWheelOption = mwGrid + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goColSizing, goEditing, goRowSelect, goThumbTracking, goSmoothScroll] + RowCount = 2 + TabOrder = 0 + OnKeyDown = DictGridKeyDown + OnSelectEditor = DictGridSelectEditor + OnSetEditText = DictGridSetEditText + end + object Panel1: TPanel + Left = 0 + Height = 49 + Top = 452 + Width = 701 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + ClientHeight = 49 + ClientWidth = 701 + TabOrder = 1 + object Label2: TLabel + AnchorSideLeft.Control = RowDelBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 109 + Height = 49 + Top = 0 + Width = 203 + Anchors = [akTop, akLeft, akBottom] + AutoSize = False + BorderSpacing.Left = 8 + Caption = 'Note: Do NOT delete a row if the data column exists' + Layout = tlCenter + ParentColor = False + WordWrap = True + end + object ReturnBtn: TButton + AnchorSideTop.Control = RowDelBtn + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 647 + Height = 25 + Top = 12 + Width = 42 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'OK' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 0 + end + object RowInstBtn: TButton + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = RowDelBtn + Left = 320 + Height = 25 + Top = 12 + Width = 118 + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Insert Row Before' + OnClick = RowInstBtnClick + TabOrder = 1 + end + object RowDelBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideBottom.Side = asrBottom + Left = 12 + Height = 25 + Top = 12 + Width = 85 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 12 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 12 + Caption = 'Delete Row' + OnClick = RowDelBtnClick + TabOrder = 2 + end + object CancelBtn: TButton + AnchorSideTop.Control = RowDelBtn + AnchorSideRight.Control = ReturnBtn + Left = 573 + Height = 25 + Top = 12 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 3 + end + end + object TypeCombo: TComboBox + AnchorSideRight.Control = JustCombo + Left = 471 + Height = 23 + Top = 8 + Width = 106 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + 'Type' + '(I)nteger' + '(F)loating Point' + '(S)tring' + '(M)oney' + '(D)ate' + ) + OnSelect = TypeComboSelect + Style = csDropDownList + TabOrder = 2 + Text = 'Type' + end + object JustCombo: TComboBox + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 585 + Height = 23 + Top = 8 + Width = 104 + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + 'Justification' + '(L)eft' + '(C)enter' + '(R)ight' + ) + OnSelect = JustComboSelect + Style = csDropDownList + TabOrder = 3 + Text = 'Justification' + end + object DescMemo: TMemo + Left = 12 + Height = 95 + Top = 342 + Width = 677 + Align = alBottom + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 12 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 12 + Lines.Strings = ( + 'Memo2' + ) + TabOrder = 4 + end + object HelpBtn: TButton + Tag = 120 + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = TypeCombo + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 25 + Top = 39 + Width = 51 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 5 + end + object Splitter1: TSplitter + Cursor = crVSplit + Left = 0 + Height = 6 + Top = 336 + Width = 701 + Align = alBottom + ResizeAnchor = akBottom + end + object Bevel1: TBevel + Left = 0 + Height = 3 + Top = 449 + Width = 701 + Align = alBottom + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/misc/dictionaryunit.pas b/applications/lazstats/source/forms/misc/dictionaryunit.pas new file mode 100644 index 000000000..e1ef99d84 --- /dev/null +++ b/applications/lazstats/source/forms/misc/dictionaryunit.pas @@ -0,0 +1,384 @@ +unit DictionaryUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Grids, ExtCtrls, + Globals, OptionsUnit, ContextHelpUnit; + +type + + { TDictionaryFrm } + + TDictionaryFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Label2: TLabel; + DescMemo: TMemo; + RowDelBtn: TButton; + RowInstBtn: TButton; + JustCombo: TComboBox; + Splitter1: TSplitter; + TypeCombo: TComboBox; + Label1: TLabel; + ReturnBtn: TButton; + CancelBtn: TButton; + DictGrid: TStringGrid; + Panel1: TPanel; + procedure DictGridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure DictGridSelectEditor(Sender: TObject; aCol, aRow: Integer; + var Editor: TWinControl); + procedure DictGridSetEditText(Sender: TObject; ACol, ARow: Integer; + const Value: string); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure JustComboClick(Sender: TObject); + procedure JustComboSelect(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure RowDelBtnClick(Sender: TObject); + procedure RowInstBtnClick(Sender: TObject); + procedure Defaults(Sender: TObject; row : integer); + procedure TypeComboSelect(Sender: TObject); + + private + { private declarations } + public + { public declarations } + procedure DelRow(row : integer); + procedure NewVar(row : integer); + procedure PasteVar(row : integer); + procedure CopyVar(row : integer); + procedure Init; + end; + +var + DictionaryFrm: TDictionaryFrm; + +implementation + +{ TDictionaryFrm } + +uses MainUnit; + +procedure TDictionaryFrm.ReturnBtnClick(Sender: TObject); +var + i, j, count : integer; + NoRows : integer; +begin + // determine number of rows with complete data + NoRows := 0; + for i := 1 to DictGrid.RowCount - 1 do + begin + count := 0; + for j := 1 to 5 do + begin + if DictGrid.Cells[j,i] <> '' then count := count + 1; + end; + if count > 4 then NoRows := NoRows + 1; + end; + if NoRows < DictGrid.RowCount - 1 then + begin + ShowMessage('Error! A definition entry for one or more variables missing!'); + DictGrid.SetFocus; + exit; + end; + + // Place short labels in main grid + OS3MainFrm.DataGrid.ColCount := NoRows + 1; + for i := 1 to NoRows do OS3MainFrm.DataGrid.Cells[i,0] := DictGrid.Cells[1,i]; + + // Make sure integers have a 0 for decimals + for i := 1 to NoRows do + if DictGrid.Cells[4,i] = 'I' then DictGrid.Cells[5,i] := '0'; + OS3MainFrm.NoVarsEdit.Text := IntToStr(OS3MainFrm.DataGrid.ColCount-1); + if OS3MainFrm.FileNameEdit.Text = '' then exit; +end; + +procedure TDictionaryFrm.RowDelBtnClick(Sender: TObject); +var + index : integer; + i, j : integer; + +begin + index := DictGrid.Row; + if index = DictGrid.RowCount-1 then // last row + begin + for i := 0 to 7 do DictGrid.Cells[i,index] := ''; + DictGrid.RowCount := DictGrid.RowCount - 1; + VarDefined[index] := false; + end + else + begin // move lines below current lines up and delete last + for i := index+1 to DictGrid.RowCount - 1 do + begin + for j := 0 to 6 do DictGrid.Cells[j,i-1] := DictGrid.Cells[j,i]; + VarDefined[i-1] := VarDefined[i]; + end; + VarDefined[DictGrid.RowCount-1] := false; + DictGrid.RowCount := DictGrid.RowCount - 1; + for i := 1 to DictGrid.RowCount - 1 do // renumber rows + DictGrid.Cells[0,i] := IntToStr(i); + end; +end; + +procedure TDictionaryFrm.RowInstBtnClick(Sender: TObject); +var + index : integer; + i, j : integer; + +begin + index := DictGrid.Row; + DictGrid.RowCount := DictGrid.RowCount + 1; // add new row to grid + // move all rows from index down 1 + for i := DictGrid.RowCount - 1 downto index+1 do + begin + for j := 1 to 6 do + begin + DictGrid.Cells[j,i] := DictGrid.Cells[j,i-1]; + end; + VarDefined[i] := VarDefined[i-1]; + end; + + // place default values in new row + Defaults(Self,index); + VarDefined[index] := true; +end; + + +procedure TDictionaryFrm.FormShow(Sender: TObject); +begin + ReturnBtn.Constraints.MinWidth := CancelBtn.Width; + Init; +end; + +procedure TDictionaryFrm.Init; +begin + DictGrid.ColCount := 8; + if NoVariables = 0 then + DictGrid.RowCount := 2 + else + DictGrid.RowCount := NoVariables + 1; + + // insert headings + DictGrid.Cells[0,0] := 'VAR/CHAR.'; + DictGrid.Cells[1,0] := 'Short Name'; + DictGrid.Cells[2,0] := 'Long Name'; + DictGrid.Cells[3,0] := 'Width'; + DictGrid.Cells[4,0] := 'Type'; + DictGrid.Cells[5,0] := 'Decimals'; + DictGrid.Cells[6,0] := 'Missing'; + DictGrid.Cells[7,0] := 'Justify'; + DictGrid.Cells[0,1] := '1'; + DictGrid.ColWidths[1] := 100; + DictGrid.ColWidths[2] := 200; + DictGrid.ColWidths[3] := 50; + DictGrid.ColWidths[4] := 50; + DictGrid.ColWidths[5] := DictGrid.Canvas.TextWidth('Decimals') + 2*varCellPadding; + DictGrid.ColWidths[6] := DictGrid.Canvas.TextWidth('Missing') + 2*varCellPadding; + DictGrid.ColWidths[7] := DictGrid.Canvas.TextWidth('Justify') + 2*varCellPadding; + + // check for absence of a defined variable + if VarDefined[1] = false then + begin + // load defaults + Defaults(Self,1); + VarDefined[1] := true; + end; +end; + +procedure TDictionaryFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TDictionaryFrm.JustComboClick(Sender: TObject); +var + achar : char; + astr : string; + index : integer; + GRow : integer; + +begin + index := JustCombo.ItemIndex; + astr := JustCombo.Items.Strings[index]; + achar := astr[2]; + GRow := DictGrid.Row; + DictGrid.Cells[7,GRow] := achar; + JustCombo.Text := 'Justification'; +end; + +procedure TDictionaryFrm.JustComboSelect(Sender: TObject); +var + achar : char; + astr : string; + index : integer; + GRow : integer; + +begin + index := JustCombo.ItemIndex; + astr := JustCombo.Items.Strings[index]; + achar := astr[2]; + GRow := DictGrid.Row; + if GRow>0 then DictGrid.Cells[7,GRow] := achar; + JustCombo.Text := 'Justification'; + DictGrid.SetFocus; +end; + +procedure TDictionaryFrm.DictGridKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +var + x, y, v : integer; +begin + x := DictGrid.Row; + y := DictGrid.Col; + v := ord(Key); + case v of + 13 : if y = 7 then DictGrid.Col := 1 else DictGrid.Col := DictGrid.Col + 1; + 40 : begin // arrow down key + if x = DictGrid.RowCount - 1 then + begin + if DictGrid.RowCount < (x + 2) then + DictGrid.RowCount := DictGrid.RowCount + 1; + Defaults(Self,x+1); + VarDefined[x+1] := true; + end; + end; + end; +end; + +procedure TDictionaryFrm.DictGridSelectEditor(Sender: TObject; aCol, + aRow: Integer; var Editor: TWinControl); +begin + if (aCol in [4, 7]) then + begin + Editor := DictGrid.EditorByStyle(cbsPickList); + if (Editor is TCustomComboBox) then + with Editor as TCustomComboBox do begin + Style := csDropDown; + case ACol of + 4: Items.CommaText := 'I,F,S,M,D'; + 7: Items.CommaText := 'L,C,R'; + end; + end + end; +end; + +procedure TDictionaryFrm.DictGridSetEditText(Sender: TObject; ACol, + ARow: Integer; const Value: string); +begin + if (ACol in [4, 7]) then + DictGrid.Cells[ACol, ARow] := UpperCase(Value); +end; + +procedure TDictionaryFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + { + if OptionsFrm = nil then + Application.CreateForm(TOptionsFrm, OptionsFrm); + } +end; + +procedure TDictionaryFrm.Defaults(Sender: TObject; row : integer); +var + i: integer; +begin + DictGrid.Cells[0,row] := IntToStr(row); + DictGrid.Cells[1,row] := 'VAR.' + IntToStr(row); + DictGrid.Cells[2,row] := 'VARIABLE ' + IntToStr(row); + DictGrid.Cells[3,row] := '8'; + DictGrid.Cells[4,row] := 'F'; + DictGrid.Cells[5,row] := '2'; + DictGrid.Cells[6, row] := MissingValueCodes[Options.DefaultMiss]; + DictGrid.Cells[7, row] := JustificationCodes[Options.DefaultJust]; + for i := 1 to DictGrid.RowCount - 1 do + DictGrid.Cells[0,i] := IntToStr(i); +end; + +procedure TDictionaryFrm.TypeComboSelect(Sender: TObject); +var + achar : char; + astr : string; + index : integer; + GRow : integer; +begin + index := TypeCombo.ItemIndex; + astr := TypeCombo.Items.Strings[index]; + achar := astr[2]; + GRow := DictGrid.Row; + if GRow>0 then + begin + DictGrid.Cells[4,GRow] := achar; + if achar='F' then DictGrid.Cells[5,GRow] := '3' // set decimal digits + else DictGrid.Cells[5,GRow] := '0'; + end; + TypeCombo.Text := 'Type'; + DictGrid.SetFocus; +end; + +procedure TDictionaryFrm.DelRow(row : integer); +begin + DictGrid.Row := row; + TempVarItm.Clear; + DictGrid.Rows[row].SaveToStream(TempVarItm); + RowDelBtnClick(Self); +end; +//------------------------------------------------------------------- + +procedure TDictionaryFrm.NewVar(row : integer); +var + i, j : integer; +begin + DictGrid.RowCount := DictGrid.RowCount + 1; // add new row + NoVariables := NoVariables + 1; + if (row < NoVariables) AND (NoVariables > 1) then // move current rows down 1 + begin + for i := NoVariables downto row + 1 do + begin + for j := 1 to 7 do DictGrid.Cells[j,i] := DictGrid.Cells[j,i-1]; + VarDefined[i] := VarDefined[i-1]; + end; + end; + // put default values in new variable + Defaults(Self,row); + VarDefined[row] := true; + + // add to grid if grid column does not exist + if OS3MainFrm.DataGrid.ColCount < row then + begin + OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 1; + OS3MainFrm.DataGrid.Cells[row,0] := DictGrid.Cells[1,row]; + end; + ReturnBtnClick(Self); +end; +//------------------------------------------------------------------- + +procedure TDictionaryFrm.PasteVar(row : integer); +var i : integer; +begin + TempVarItm.Position := 0; + DictGrid.Rows[row].LoadFromStream(TempVarItm); + for i := 1 to DictGrid.RowCount - 1 do DictGrid.Cells[0,i] := IntToStr(i); +// FormShow(Self); +end; +//------------------------------------------------------------------- + +procedure TDictionaryFrm.CopyVar(row : integer); +begin + DictGrid.Row := row; + TempVarItm.Clear; + DictGrid.Rows[row].SaveToStream(TempVarItm); +end; +//------------------------------------------------------------------- + +initialization + {$I dictionaryunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/misc/graphlib.lfm b/applications/lazstats/source/forms/misc/graphlib.lfm new file mode 100644 index 000000000..54d6a3ee9 --- /dev/null +++ b/applications/lazstats/source/forms/misc/graphlib.lfm @@ -0,0 +1,90 @@ +object GraphFrm: TGraphFrm + Left = 444 + Height = 494 + Top = 174 + Width = 721 + ActiveControl = ReturnBtn + Caption = 'Graphic Display' + ClientHeight = 494 + ClientWidth = 721 + OnActivate = FormActivate + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Image1: TImage + Left = 8 + Height = 436 + Top = 8 + Width = 705 + Align = alClient + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + end + object Panel1: TPanel + Left = 8 + Height = 26 + Top = 460 + Width = 705 + Align = alBottom + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 26 + ClientWidth = 705 + TabOrder = 0 + object PrintBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 327 + Height = 25 + Top = 1 + Width = 51 + AutoSize = True + Caption = 'Print' + OnClick = PrintBtnClick + TabOrder = 1 + end + object ReturnBtn: TButton + AnchorSideLeft.Control = PrintBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Side = asrBottom + Left = 390 + Height = 25 + Top = 1 + Width = 61 + AutoSize = True + BorderSpacing.Left = 12 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 2 + end + object SaveBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = PrintBtn + Left = 229 + Height = 25 + Top = 1 + Width = 86 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'Save Image' + OnClick = SaveBtnClick + TabOrder = 0 + end + end + object Bevel1: TBevel + Left = 0 + Height = 8 + Top = 444 + Width = 721 + Align = alBottom + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/misc/graphlib.pas b/applications/lazstats/source/forms/misc/graphlib.pas new file mode 100644 index 000000000..26192aee5 --- /dev/null +++ b/applications/lazstats/source/forms/misc/graphlib.pas @@ -0,0 +1,1575 @@ +unit GraphLib; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, Printers, Math, + Globals; + + +type + + { TGraphFrm } + + TGraphFrm = class(TForm) + Bevel1: TBevel; + SaveBtn: TButton; + Image1: TImage; + PrintBtn: TButton; + ReturnBtn: TButton; + Panel1: TPanel; + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure PrintBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure SaveBtnClick(Sender: TObject); + private + { private declarations } + ImageWidth : integer; + ImageHeight : integer; + XOffset : integer; + YOffset : integer; + XAxisLength : integer; + YAxisLength : integer; + DegAngle : real; + RadAngle : real; + TanAngle : real; + BarWidth : integer; + XStart : integer; + XEnd : integer; + YStart : integer; + YEnd : integer; + Gtype : integer; + NoBars : integer; + NSets : integer; + YMax : real; + YMin : real; + XProp : real; + Colors : Array[0..11] of integer; + + procedure Bar2D(Sender: TObject); + procedure Bar3D(Sender: TObject); + procedure Pie2D(Sender: TObject); + procedure Pie3D(Sender: TObject); + procedure Line2D(Sender: TObject); + procedure Line3D(Sender: TObject); + procedure Plot2D(Sender: TObject); + procedure Plot3D(Sender: TObject); + procedure MakeXAxis(Sender: TObject); + procedure MakeYAxis(Sender: TObject); + procedure MakeHXaxis(Sender: TObject); + procedure MakeHYaxis(Sender: TObject); + procedure HBar2D(Sender: TObject); + procedure HBar3D(Sender: TObject); + procedure Walls(Sender: TObject); + procedure pBar2D(Sender: TObject); + procedure pBar3D(Sender: TObject); + procedure pPie2D(Sender: TObject); + procedure pExPie(Sender: TObject); + procedure pLine2D(Sender: TObject); + procedure pLine3D(Sender: TObject); + procedure pPlot2D(Sender: TObject); + procedure pPlot3D(Sender: TObject); + procedure pMakeXAxis(Sender: TObject); + procedure pMakeYaxis(Sender: TObject); + procedure pMakeHXaxis(Sender: TObject); + procedure pMakeHYaxis(Sender: TObject); + procedure pHBar2D(Sender: TObject); + procedure pHBar3D(Sender: TObject); + procedure pWalls(Sender: TObject); + + public + { public declarations } + nosets : integer; //number of data sets to plot + nbars : integer; // maximum number of bars to plot in any set + Heading : String; // Major Heading for graph + XTitle : string; // title for x-axis + YTitle : string; // title for vertical axis + barwideprop : real; // proportional width of bar (0 to 1.0) + GraphType : integer; //1=2dbar,2=3dbar,3=2dpie,4=3dpie,5=2dline,6=3dline + //7=2dpoints,8=3dpoints + Ypoints, Xpoints : DblDyneMat; + SetLabels : array[1..20] of string[21]; // labels for multiple sets + PointLabels : array[1..1000] of string[3]; // individual point labels + PtLabels : boolean; // true to print point labels (for 2D Plot only) + AutoScaled : boolean; // if true, program uses computed min and max values + ShowLeftWall : boolean; + ShowRightWall : boolean; + ShowBottomWall : boolean; + ShowBackWall : boolean; + BackColor : integer; + WallColor : integer; + FloorColor : integer; + miny : double; // specified by user if autoscaled is false + maxy : double; // specified by user if autoscaled is false + + end; + +var + GraphFrm: TGraphFrm; + +implementation + +{ TGraphFrm } + +procedure TGraphFrm.PrintBtnClick(Sender: TObject); +begin + Printer.Orientation := poLandscape; + ImageWidth := Printer.PageWidth - 100; + ImageHeight := Printer.PageHeight - 100; + XOffset := ImageWidth div 10; + YOffset := ImageHeight div 10; + XStart := Xoffset; + XEnd := ImageWidth - XOffset; + XAxisLength := XEnd - XStart; + YStart := ImageHeight - YOffset; + YEnd := YOffset; + YAxisLength := YStart - YEnd; + DegAngle := 45.0; + RadAngle := DegToRad(DegAngle); + TanAngle := Tan(RadAngle); + NoBars := nbars; + NSets := nosets; + XProp := barwideprop; + BarWidth := XAxisLength div NoBars; + // draw border around graph + Printer.BeginDoc; + BackColor := clWhite; + Printer.Canvas.Brush.Color := BackColor; + Printer.Canvas.Rectangle(100,100,ImageWidth,ImageHeight); + Printer.Canvas.TextOut(ImageWidth div 2,YEnd - 100,Heading); + Caption := Heading; + if (GType < 1) or (GType > 10) then + begin +// Application.MessageBox('No graph type defined.','ERROR!',MB_OK); + Printer.Enddoc; + exit; + end + else case GType of + 1 : pBar2D(self); // two dimension vertical bars + 2 : pBar3D(self); // three dimension vertical bars + 3 : pPie2D(self); // two dimension pie chart + 4 : pExPie(self); // exploded pie chart + 5 : pLine2D(self); // Two dimension lines + 6 : pLine3D(self); // three dimension lines + 7 : pPlot2D(self); // two dimension points + 8 : pPlot3D(self); // three dimension points + 9 : pHBar2D(self); // Two dimension horizontal bars + 10: pHBar3D(self); // Three dimension horizontal bars + end; + Printer.EndDoc; { finish printing } + Printer.Orientation := poPortrait; + +end; + +procedure TGraphFrm.FormShow(Sender: TObject); +var + i, j: integer; +begin + Gtype := 1; // default type is a 2 dimension bar graph + ImageWidth := Image1.Width; + ImageHeight := Image1.Height; + XOffset := ImageWidth div 10; + YOffset := ImageHeight div 10; + XStart := Xoffset; + XEnd := ImageWidth - XOffset; + XAxisLength := XEnd - XStart; + YStart := ImageHeight - YOffset; + YEnd := YOffset; + YAxisLength := YStart - YEnd; + DegAngle := 45.0; + RadAngle := DegToRad(DegAngle); + TanAngle := Tan(RadAngle); + NoBars := nbars; + NSets := nosets; + XProp := barwideprop; + BarWidth := XAxisLength div NoBars; + GType := GraphType; + Colors := DATA_COLORS; + + // draw border around graph + Image1.Canvas.Brush.Color := BackColor; + Image1.Canvas.Rectangle(0,0, ImageWidth, ImageHeight); + Image1.Canvas.TextOut((ImageWidth - Image1.Canvas.TextWidth(Heading)) div 2, 2, Heading); + + Caption := Heading; + + if AutoScaled then + begin + YMin := YPoints[0,0]; + YMax := YMin; + for i := 1 to NSets do + begin + for j := 2 to NoBars do + begin + if YPoints[i-1,j-1] > YMax then YMax := YPoints[i-1,j-1]; + if YPoints[i-1,j-1] < YMin then YMin := YPoints[i-1,j-1]; + end; + end; + end else + begin + YMin := miny; + YMax := maxy; + end; + + case GType of + 1 : Bar2D(self); + 2 : Bar3D(self); + 3 : Pie2D(self); + 4 : Pie3D(self); + 5 : Line2D(self); + 6 : Line3D(self); + 7 : Plot2D(self); + 8 : Plot3D(self); + 9 : HBar2D(self); + 10: HBar3D(self); + else exit; + end; +end; + +procedure TGraphFrm.ReturnBtnClick(Sender: TObject); +begin + Close; +end; + +procedure TGraphFrm.SaveBtnClick(Sender: TObject); +VAR + response : string; +begin + response := InputBox('NAME?','Name of bitmap file:','image.bmp'); + Image1.Picture.SaveToFile(response); +end; + +procedure TGraphFrm.Bar2D(Sender: TObject); +var + j : integer; + x1, y1, x2, y2 : integer; + bwidth : integer; + xpos : integer; + yprop : real; + ydist : real; +begin + MakeXAxis(self); + MakeYAxis(self); + { Make bar for each y data point } + for j := 1 to NoBars do + begin + Image1.Canvas.Brush.Color := Colors[j mod 12]; + bwidth := round(XProp * BarWidth); + xpos := XStart + (BarWidth * j) - (BarWidth div 2); + x1 := xpos - (bwidth div 2); + x2 := x1 + bwidth; + y1 := YStart; +// yprop := (YPoints[1]^[j]- YMin) / (YMax - YMin); + yprop := (YPoints[0,j-1] - YMin) / (YMax - YMin); + ydist := yprop * YAxisLength; + y2 := YStart - round(ydist); + Image1.Canvas.Polygon([Point(x1,y1),Point(x2,y1),Point(x2,y2),Point(x1,y2)]); + end; +end; +//--------------------------------------------------------------------- + +procedure TGraphFrm.HBar2D(Sender: TObject); +var + j : integer; + x1, y1, x2, y2 : integer; + bwidth : integer; + ypos : integer; + xdist : real; + yprop : real; +begin + BarWidth := YAxisLength div NoBars; + MakeHXAxis(self); + MakeHYAxis(self); + { Make bar for each y data point } + for j := 1 to NoBars do + begin + Image1.Canvas.Brush.Color := Colors[j mod 12]; + bwidth := round(XProp * BarWidth); + ypos := YStart - (BarWidth * j) + (BarWidth div 2); // bar center + y1 := ypos - (bwidth div 2); + y2 := y1 + bwidth; + x1 := XStart; + yprop := (YPoints[0,j-1] - YMin) / (YMax - YMin); + xdist := yprop * XAxisLength; + x2 := XStart + round(xdist); + Image1.Canvas.Polygon([Point(x1,y1),Point(x2,y1),Point(x2,y2),Point(x1,y2)]); + end; +end; +//---------------------------------------------------------------------- + +procedure TGraphFrm.HBar3D(Sender: TObject); +var + i, j : integer; + x1, x2, x3, x4, y1, y2, y3, y4 : integer; + triheight : integer; + bwidth : integer; + ypos : integer; + xdist : real; + yprop : real; +// yoffset : integer; +// xoffset : integer; + triwidth : integer; + +begin + Walls(self); // create left and bottom wall and axes + BarWidth := YAxisLength div NoBars; + Image1.Canvas.Brush.Color := BackColor; + MakeHXAxis(self); + MakeHYAxis(self); + bwidth := round(XProp * BarWidth); + triwidth := round(bwidth * cos(RadAngle)); + triheight := round(bwidth * sin(RadAngle)); + triheight := triheight div 2; // scale down depth of view + for i := 1 to NSets do + begin + xoffset := triwidth * (i - 1); + yoffset := triheight * (i - 1); + { Make bar for each y data point } + for j := 1 to NoBars do + begin + // do face + Image1.Canvas.Brush.Color := Colors[j mod 12]; + ypos := YStart - (BarWidth * j) + (BarWidth div 2); // bar center + y1 := ypos - (bwidth div 2) - yoffset; + y2 := y1 + bwidth; + x1 := XStart + xoffset; + yprop := (YPoints[0,j-1] - YMin) / (YMax - YMin); + xdist := yprop * XAxisLength; + x2 := XStart + round(xdist) + xoffset; + Image1.Canvas.Polygon([Point(x1,y1),Point(x2,y1),Point(x2,y2),Point(x1,y2)]); + // do side (end of bar ) + x1 := x2; + x2 := x1 + triwidth; + y1 := y2; + y2 := y1 - triheight; + y3 := y2 - bwidth; + y4 := y1 - bwidth; + Image1.Canvas.Polygon([Point(x1,y1),Point(x2,y2),Point(x2,y3),Point(x1,y4)]); + // do top of bar + x3 := XStart + xoffset; + x4 := x3 + triwidth; + Image1.Canvas.Polygon([Point(x3,y4),Point(x1,y4),Point(x2,y3),Point(x4,y3)]); + end; + end; +end; +//---------------------------------------------------------------------- + +procedure TGraphFrm.Bar3D(Sender: TObject); +var + i, j : integer; + x1, x2, x3, x4, y1, y2, y3, y4 : integer; + triheight : integer; + bwidth : integer; + yprop : real; +// yoffset : integer; +// xoffset : integer; + xpos : integer; + ydist : integer; + triwidth : integer; + +begin + Walls(self); // create left and bottom wall and axes + Image1.Canvas.Brush.Color := BackColor; + MakeXAxis(self); + MakeYAxis(self); + bwidth := round(XProp * BarWidth); + triwidth := round(bwidth * cos(RadAngle)); + triheight := round(bwidth * sin(RadAngle)); + triheight := triheight div 2; // scale down depth of view + for i := NSets downto 1 do + begin + xoffset := triwidth * (i - 1); + yoffset := triheight * (i - 1); + for j := 1 to NoBars do + begin + Image1.Canvas.Brush.Color := Colors[j mod 12]; + xpos := XStart + (BarWidth * j) - (BarWidth div 2); + x1 := xpos - (bwidth div 2); + x2 := x1 + bwidth; + y1 := YStart; + yprop := (YPoints[i-1,j-1] - YMin) / (YMax - YMin); + ydist := round(yprop * YAxisLength); + y2 := YStart - round(ydist); + x1 := x1 + xoffset; + x2 := x2 + xoffset; + y1 := y1 - yoffset; + y2 := y2 - yoffset; + // draw face + Image1.Canvas.Polygon([Point(x1,y1),Point(x2,y1),Point(x2,y2),Point(x1,y2)]); + // draw side + x1 := x2; + x2 := x1 + triwidth; + y2 := y1 - triheight; + y3 := y1 - round(ydist); + y4 := y2 - round(ydist); + Image1.Canvas.Polygon([Point(x1,y1),Point(x2,y2),Point(x2,y4),Point(x1,y3)]); + // draw top + x1 := xpos - (bwidth div 2) + xoffset; + x2 := x1 + bwidth; + x3 := x2 + triwidth; + x4 := x1 + triwidth; + y1 := YStart - yoffset - round(ydist); + y2 := y1 - triheight; + Image1.Canvas.Polygon([Point(x1,y1),Point(x2,y1),Point(x3,y2),Point(x4,y2)]); + end; + x1 := XStart + XAxisLength + xoffset; + y1 := YStart - triheight * i; + Image1.Canvas.Brush.Color := clWhite; + Image1.Canvas.TextOut(x1,y1,SetLabels[i]); + end; +end; +//--------------------------------------------------------------------- + +procedure TGraphFrm.Pie2D(Sender: TObject); +var + i : integer; + x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6 : integer; + yprop : real; + xcenter, ycenter : double; + Total : double; + radians : double; + radius : integer; + cum : double; + value : string; + +begin + xcenter := ImageWidth div 2; + ycenter := ImageHeight div 2; + + // get the total for obtaining proportions that each y point is of the total + Total := 0.0; + cum := 0.0; + radius := round(ycenter) - YOffset; + x1 := ImageWidth div 2 - Image1.Canvas.TextWidth(XTitle) div 2; + Image1.Canvas.TextOut(x1,YStart + 25,XTitle); + x1 := round(xcenter-radius); // left of rectangle + y1 := round(ycenter-radius); // top of rectangle + x2 := round(xcenter + radius); // right of rectangle + y2 := round(ycenter + radius); // bottom of rectangle + x3 := x2; + y3 := round(ycenter); + for i := 1 to NoBars do Total := Total + YPoints[0,i-1]; + // plot an arc corresponding to each proportion starting at radian 0 + for i := 1 to NoBars do + begin + yprop := YPoints[0,i-1] / Total; + cum := cum + yprop; + radians := cum * 2.0 * Pi; + x4 := round(xcenter + radius * cos(radians)); + y4 := round(ycenter - (radius * sin(radians))); + Image1.Canvas.Brush.Color := Colors[i mod 12]; + if yprop > 0.0 then + begin + Image1.Canvas.Pie(x1,y1,x2,y2,x3,y3,x4,y4); + radians := (cum - (yprop / 2.0)) * 2.0 * Pi; + x5 := round(xcenter + radius * cos(radians)); + y5 := round(ycenter - radius * sin(radians)); + Image1.Canvas.MoveTo(x5,y5); + if x5 >= round(xcenter) then x6 := x5 + 20 + else x6 := x5 - 20; + if y5 >= round(ycenter) then y6 := y5 + 20 + else y6 := y5 - 20; + Image1.Canvas.LineTo(x6,y6); + Image1.Canvas.Brush.Color := BackColor; + value := format('%8.5g',[XPoints[0,i-1]]); + Image1.Canvas.TextOut(x6,y6,value); + if x5 >= round(xcenter) then x6 := x5 - 20 + else x6 := x5 + 20; + if y5 >= round(ycenter) then y6 := y5 - 20 + else y6 := y5 + 20; + value := format('%4.2f',[yprop*100.0]); + value := value + '%'; + Image1.Canvas.TextOut(x6,y6,value); + x3 := x4; + y3 := y4; + end; + end; +end; +//--------------------------------------------------------------------- + +procedure TGraphFrm.Pie3D(Sender: TObject); +var + i : integer; + x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6 : integer; + yprop : real; + xcenter, ycenter : double; + Total : double; + radians : double; + midradians : double; + radius : integer; + cum : double; + value : string; + +begin + ycenter := ImageHeight div 2; + // get the total for obtaining proportions that each y point is of the total + Total := 0.0; + cum := 0.0; + radius := round(ycenter) - YOffset; + x1 := ImageWidth div 2 - Image1.Canvas.TextWidth(XTitle) div 2; + Image1.Canvas.TextOut(x1,YStart + 25,XTitle); + for i := 1 to NoBars do Total := Total + YPoints[0,i-1]; + // plot an arc corresponding to each proportion starting at radian 0 + for i := 1 to NoBars do + begin + xcenter := ImageWidth div 2; + ycenter := ImageHeight div 2; + yprop := YPoints[0,i-1] / Total; + cum := cum + yprop; + radians := cum * 2.0 * Pi; + midradians := (cum - (yprop / 2.0)) * 2.0 * Pi; + x5 := round(xcenter + radius * cos(midradians)); + y5 := round(ycenter - radius * sin(midradians)); + // explode pie by shifting slices away from center + if x5 >= round(xcenter) then xcenter := xcenter + 10 + else xcenter := xcenter - 10; + if y5 >= round(ycenter) then ycenter := ycenter + 10 + else ycenter := ycenter - 10; + x1 := round(xcenter-radius); // left of rectangle + y1 := round(ycenter-radius); // top of rectangle + x2 := round(xcenter + radius); // right of rectangle + y2 := round(ycenter + radius); // bottom of rectangle + midradians := (cum - yprop ) * 2.0 * Pi; + x3 := round(xcenter + radius * cos(midradians)); + y3 := round(ycenter - radius * sin(midradians)); + x4 := round(xcenter + radius * cos(radians)); + y4 := round(ycenter - (radius * sin(radians))); + Image1.Canvas.Brush.Color := Colors[i mod 12]; + if yprop > 0.0 then + begin + Image1.Canvas.Pie(x1,y1,x2,y2,x3,y3,x4,y4); + radians := (cum - (yprop / 2.0)) * 2.0 * Pi; + x5 := round(xcenter + radius * cos(radians)); + y5 := round(ycenter - radius * sin(radians)); + Image1.Canvas.MoveTo(x5,y5); + if x5 >= round(xcenter) then x6 := x5 + 20 + else x6 := x5 - 20; + if y5 >= round(ycenter) then y6 := y5 + 20 + else y6 := y5 - 20; + Image1.Canvas.LineTo(x6,y6); + Image1.Canvas.Brush.Color := BackColor; + value := format('%8.5g',[XPoints[0,i-1]]); + Image1.Canvas.TextOut(x6,y6,value); + if x5 >= round(xcenter) then x6 := x5 - 20 + else x6 := x5 + 20; + if y5 >= round(ycenter) then y6 := y5 - 20 + else y6 := y5 + 20; + value := format('%4.2f',[yprop*100.0]); + value := value + '%'; + Image1.Canvas.TextOut(x6,y6,value); + end; + end; +end; +//--------------------------------------------------------------------- + +procedure TGraphFrm.Line2D(Sender: TObject); +{ This procedure draws lines for 1 or more sets (on top of each other if + multiple sets) } +var + i, j : integer; + x1, y1, x2, y2 : integer; + xpos : integer; + yprop : real; + ydist : real; +begin + MakeXAxis(self); + MakeYAxis(self); + { Make lines for each set of y data point } + For i := NSets downto 1 do + begin + Image1.Canvas.Pen.Color := Colors[i mod 12]; + x1 := XStart + BarWidth div 2; + x2 := x1; + yprop := (YPoints[i-1,0] - YMin) / (YMax - YMin); + ydist := yprop * YAxisLength; + y1 := YStart - round(ydist); + y2 := y1; + Image1.Canvas.MoveTo(x1,y1); + for j := 2 to NoBars do + begin + xpos := XStart + (BarWidth * j) - (BarWidth div 2); + x2 := xpos; + yprop := (YPoints[i-1,j-1] - YMin) / (Ymax - YMin); + ydist := yprop * YAxisLength; + y2 := YStart - round(ydist); + Image1.Canvas.LineTo(x2,y2); + end; + Image1.Canvas.Pen.Color := clBlack; + x1 := x2; + y1 := y2; + Image1.Canvas.Brush.Color := clWhite; + Image1.Canvas.TextOut(x1,y1,SetLabels[i]); + end; + Image1.Canvas.Pen.Color := clBlack; +end; +//--------------------------------------------------------------------- + +procedure TGraphFrm.Line3D(Sender: TObject); +{ This procedure draws lines for multiple sets but staggers each set back and + to the right } +var + i, j : integer; + x1, x2, x3, x4, y1, y2, y3, y4 : integer; + triheight : integer; + bwidth : integer; + yprop : double; + points : array[0..4] of TPoint; + xpos : integer; + ydist : integer; + triwidth : integer; +begin + + Walls(self); // create left and bottom wall and axes + Image1.Canvas.Brush.Color := BackColor; + MakeXAxis(self); + MakeYAxis(self); + bwidth := BarWidth; + triwidth := round(bwidth * cos(RadAngle)); + triheight := round(bwidth * sin(RadAngle)); + triheight := triheight div 2; // scale down depth of view + for i := NSets downto 1 do + begin + xoffset := triwidth * (i - 1); + yoffset := triheight * (i - 1); + Image1.Canvas.Brush.Color := Colors[i mod 12]; + for j := 1 to NoBars-1 do + begin + xpos := XStart + (BarWidth * j) - (BarWidth div 2); + x1 := xpos - (bwidth div 2) + xoffset; + x2 := x1 + bwidth; + x3 := x2 + triwidth; + x4 := x1 + triwidth; + yprop := (YPoints[i-1,j-1] - YMin) / (YMax - YMin); + ydist := round(yprop * YAxisLength); + y1 := YStart - yoffset - round(ydist); + y2 := y1 - triheight; + yprop := (YPoints[i-1,j] - YMin) / (YMax - YMin); + ydist := round(yprop * YAxisLength); + y3 := ystart - yoffset - round(ydist); + y4 := y3 - triheight; + points[0] := Point(x1,y1); + points[1] := Point(x2,y2); + points[2] := Point(x3,y4); + points[3] := Point(x4,y3); + Image1.Canvas.Polygon(points,4); + end; + x1 := XStart + XAxisLength + xoffset; + y1 := YStart - triheight * i; + Image1.Canvas.Brush.Color := clWhite; + Image1.Canvas.TextOut(x1,y1,SetLabels[i]); + end; +end; +//--------------------------------------------------------------------- + +procedure TGraphFrm.Plot2D(Sender: TObject); +var + i, j : integer; + x1, y1 : integer; + triheight : integer; + bwidth : integer; + yprop : real; +// yoffset : integer; +// xoffset : integer; + xpos : integer; + ydist : integer; + triwidth : integer; +begin + //Walls(self); // create left and bottom wall and axes + Image1.Canvas.Brush.Color := BackColor; + MakeXAxis(self); + MakeYAxis(self); + bwidth := round(XProp * BarWidth); + triwidth := round(bwidth * cos(RadAngle)); + triheight := round(bwidth * sin(RadAngle)); + triheight := triheight div 2; // scale down depth of view + { Make points for each set of y data point } + for i := NSets downto 1 do + begin + Image1.Canvas.Brush.Color := Colors[i mod 12]; + xoffset := triwidth * (i - 1); + yoffset := triheight * (i - 1); + for j := 1 to NoBars do + begin + xpos := XStart + (BarWidth * j) - (BarWidth div 2); + x1 := xpos; + yprop := (YPoints[i-1,j-1] - YMin) / (YMax - YMin); + ydist := round(yprop * YAxisLength); + y1 := YStart - round(ydist); + x1 := x1 + xoffset; + y1 := y1 - yoffset; + if PtLabels then + begin + Image1.Canvas.Brush.Color := BackColor; + Image1.Canvas.TextOut(x1,y1,PointLabels[j]); + end + else + Image1.Canvas.Ellipse(x1-5,y1-5,x1+5,y1+5); + end; + Image1.Canvas.Pen.Color := clBlack; + x1 := XStart + XAxisLength + xoffset; + y1 := YStart - triheight * i; + Image1.Canvas.Brush.Color := clWhite; + Image1.Canvas.TextOut(x1,y1,SetLabels[i]); + end; +end; +//--------------------------------------------------------------------- + +procedure TGraphFrm.Plot3D(Sender: TObject); +var + i, j : integer; + x1, y1 : integer; + yprop : real; + triheight : integer; + bwidth : integer; +// yoffset : integer; +// xoffset : integer; + xpos : integer; + ydist : integer; + triwidth : integer; +begin + Walls(self); // create left and bottom wall and axes + Image1.Canvas.Brush.Color := BackColor; + MakeXAxis(self); + MakeYAxis(self); + bwidth := round(XProp * BarWidth); + triwidth := round(bwidth * cos(RadAngle)); + triheight := round(bwidth * sin(RadAngle)); + triheight := triheight div 2; // scale down depth of view + { Make points for each set of y data point } + for i := NSets downto 1 do + begin + Image1.Canvas.Brush.Color := Colors[i mod 12]; + xoffset := triwidth * (i - 1); + yoffset := triheight * (i - 1); + for j := 1 to NoBars do + begin + xpos := XStart + (BarWidth * j) - (BarWidth div 2); + x1 := xpos; + yprop := (YPoints[i-1,j-1] - YMin) / (YMax - YMin); + ydist := round(yprop * YAxisLength); + y1 := YStart - round(ydist); + x1 := x1 + xoffset; + y1 := y1 - yoffset; + // change next to a ball by drawing multiple Ellipses around + // vertical axis ? + Image1.Canvas.Ellipse(x1-5,y1-5,x1+5,y1+5); + Image1.Canvas.Ellipse(x1-4,y1-5,x1+4,y1+5); + Image1.Canvas.Ellipse(x1-3,y1-5,x1+3,y1+5); + Image1.Canvas.Ellipse(x1-2,y1-5,x1+2,y1+5); + end; + Image1.Canvas.Pen.Color := clBlack; + x1 := XStart + XAxisLength + xoffset; + y1 := YStart - triheight * i; + Image1.Canvas.Brush.Color := clWhite; + Image1.Canvas.TextOut(x1,y1,SetLabels[i]); + end; +end; +//--------------------------------------------------------------------- + +procedure TGraphFrm.MakeXAxis(Sender: TObject); +var + i, valstart, valend, oldend: integer; + xpos: integer; + value: string; +begin + Image1.Canvas.Line(XStart, YStart, XEnd, YStart); + oldend := 0; + for i := 1 to NoBars do + begin + xpos := XStart + (BarWidth * i) - (BarWidth div 2); + Image1.Canvas.Line(xpos, YStart, xpos, YStart + 5); + value := Format('%.5g', [XPoints[0, i-1]]); + valstart := xpos - Image1.Canvas.TextWidth(value) div 2; + valend := valstart + Image1.Canvas.TextWidth(value); + if valstart > oldend then + begin + Image1.Canvas.TextOut(valstart,YStart+10,value); + oldend := valend; + end; + end; + xpos := (ImageWidth - Image1.Canvas.TextWidth(XTitle)) div 2; + Image1.Canvas.TextOut(xpos, YStart + 25, XTitle); +end; + +procedure TGraphFrm.MakeYAxis(Sender: TObject); +var + ypos: integer; + i: integer; + incr: Double; + value: Double; + valstring: string; + h: Integer; + w: Integer; +begin + h := Image1.Canvas.TextHeight('g'); + Image1.Canvas.Line(XStart, YStart, XStart, YEnd); + incr := (YMax - YMin) / 20.0; + for i := 1 to 21 do + begin + value := YMin + incr * (i-1); + ypos := YStart - (i-1) * YAxisLength div 20; + Image1.Canvas.MoveTo(XStart, ypos); + Image1.Canvas.LineTo(XStart-10, ypos); + valstring := Format('%.2f', [value]); + w := Image1.Canvas.TextWidth(valstring); + Image1.Canvas.TextOut(XStart - 20 - w, ypos - h div 2, valstring); + end; + ypos := YEnd - 10 - Canvas.TextHeight(YTitle); + Image1.Canvas.TextOut(2, ypos, YTitle); +end; + +procedure TGraphFrm.MakeHXaxis(Sender: TObject); +var + xpos : integer; + i : integer; + incr : real; + value : real; + valstring : string; + +begin + Image1.Canvas.MoveTo(XStart,YStart); + Image1.Canvas.LineTo(XEnd,YStart); + incr := (YMax - YMin) / 20.0; + for i := 1 to 21 do + begin + value := YMin + (incr * (i-1)); + xpos := XStart + ((i-1) * XAxisLength div 20); + Image1.Canvas.MoveTo(xpos,YStart); + Image1.Canvas.LineTo(xpos,YStart + 5); + valstring := format('%6.2f',[value]); + Image1.Canvas.TextOut(xpos - Image1.Canvas.TextWidth(valstring) div 2, + YStart + 10,FloatToStr(value)); + end; + xpos := XAxisLength div 2 - Image1.Canvas.TextWidth(YTitle) div 2; + Image1.Canvas.TextOut(xpos,YStart + 20,YTitle); +end; +//--------------------------------------------------------------------- + +procedure TGraphFrm.MakeHYaxis(Sender: TObject); +var + i : integer; + ypos : integer; + value : string; +begin + Image1.Canvas.MoveTo(XStart,YStart); + Image1.Canvas.LineTo(XStart,YEnd); + for i := 1 to NoBars do + begin + ypos := YStart - (BarWidth * i) + (BarWidth div 2); + Image1.Canvas.MoveTo(XStart,ypos); + Image1.Canvas.LineTo(XStart - 10,ypos); + value := format('%6.5g',[XPoints[0,i-1]]); + Image1.Canvas.TextOut(XStart-10-Image1.Canvas.TextWidth(value), + ypos,value); + end; + ypos := YEnd; + Image1.Canvas.TextOut(0,ypos,XTitle); +end; + +procedure TGraphFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([SaveBtn.Width, PrintBtn.Width, ReturnBtn.Width]); + SaveBtn.Constraints.MinWidth := w; + PrintBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +//--------------------------------------------------------------------- + +procedure TGraphFrm.Walls(Sender: TObject); +var + deep : integer; + triheight : integer; + x1, x2,x3, x4, y1, y2, y3, y4 : integer; // polygon vertices + bwide : integer; +// xoffset : integer; + +begin + bwide := round(BarWidth * XProp); + xoffset := round(bwide * cos(RadAngle)); + XAxisLength := XAxisLength - (NSets * xoffset); // new length of X Axis + XEnd := XStart + XAxisLength; + BarWidth := XAxisLength div NoBars; //Adjusted bar width + bwide := round(BarWidth * XProp); + xoffset := round(bwide * cos(RadAngle)); + deep := xoffset * NSets; + triheight := round(bwide * sin(RadAngle) * NSets); // total height of additional y needed + triheight := triheight div 2; // scale down depth of view + YAxisLength := YAxisLength - triheight; + YEnd := YStart - YAxisLength; + // do left wall + x1 := XStart; + x2 := x1 + deep; + y1 := YStart; + y2 := YStart - triheight; + y3 := YStart - YAxisLength - triheight; + y4 := YEnd; + Image1.Canvas.Brush.Color := WallColor; + Image1.Canvas.Polygon([Point(x1,y1),Point(x2,y2),Point(x2,y3),Point(x1,y4)]); + // do floor + x1 := XStart; + x2 := XStart + deep; + x3 := XEnd; + x4 := XEnd + deep; + y1 := YStart; + y2 := YStart - triheight; + Image1.Canvas.Brush.Color := FloorColor; + Image1.Canvas.Polygon([Point(x1,y1),Point(x3,y1),Point(x4,y2),Point(x2,y2)]); +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pHBar2D(Sender: TObject); +var + j : integer; + x1, y1, x2, y2 : integer; + bwidth : integer; + ypos : integer; + xdist : real; + yprop : real; +begin + BarWidth := YAxisLength div NoBars; + pMakeHXAxis(self); + pMakeHYAxis(self); + { Make bar for each y data point } + for j := 1 to NoBars do + begin + Printer.Canvas.Brush.Color := Colors[j mod 12]; + bwidth := round(XProp * BarWidth); + ypos := YStart - (BarWidth * j) + (BarWidth div 2); // bar center + y1 := ypos - (bwidth div 2); + y2 := y1 + bwidth; + x1 := XStart; + yprop := (YPoints[0,j-1] - YMin) / (YMax - YMin); + xdist := yprop * XAxisLength; + x2 := XStart + round(xdist); + Printer.Canvas.Polygon([Point(x1,y1),Point(x2,y1),Point(x2,y2),Point(x1,y2)]); + end; +end; +//----------------------------------------------------------------------- + +procedure TGraphFrm.pHBar3D(Sender: TObject); +var + i, j : integer; + x1, x2, x3, x4, y1, y2, y3, y4 : integer; + triheight : integer; + bwidth : integer; + ypos : integer; + xdist : real; + yprop : real; +// yoffset : integer; +// xoffset : integer; + triwidth : integer; + +begin + pWalls(self); // create left and bottom wall and axes + BarWidth := YAxisLength div NoBars; + Printer.Canvas.Brush.Color := BackColor; + pMakeHXAxis(self); + pMakeHYAxis(self); + bwidth := round(XProp * BarWidth); + triwidth := round(bwidth * cos(RadAngle)); + triheight := round(bwidth * sin(RadAngle)); + triheight := triheight div 2; // scale down depth of view + for i := 1 to NSets do + begin + xoffset := triwidth * (i - 1); + yoffset := triheight * (i - 1); + { Make bar for each y data point } + for j := 1 to NoBars do + begin + // do face + Printer.Canvas.Brush.Color := Colors[j mod 12]; + ypos := YStart - (BarWidth * j) + (BarWidth div 2); // bar center + y1 := ypos - (bwidth div 2) - yoffset; + y2 := y1 + bwidth; + x1 := XStart + xoffset; + yprop := (YPoints[0,j-1] - YMin) / (YMax - YMin); + xdist := yprop * XAxisLength; + x2 := XStart + round(xdist) + xoffset; + Printer.Canvas.Polygon([Point(x1,y1),Point(x2,y1),Point(x2,y2),Point(x1,y2)]); + // do side (end of bar ) + x1 := x2; + x2 := x1 + triwidth; + y1 := y2; + y2 := y1 - triheight; + y3 := y2 - bwidth; + y4 := y1 - bwidth; + Printer.Canvas.Polygon([Point(x1,y1),Point(x2,y2),Point(x2,y3),Point(x1,y4)]); + // do top of bar + x3 := XStart + xoffset; + x4 := x3 + triwidth; + Printer.Canvas.Polygon([Point(x3,y4),Point(x1,y4),Point(x2,y3),Point(x4,y3)]); + end; + end; +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pWalls(Sender: TObject); +var + deep : integer; + triheight : integer; + x1, x2,x3, x4, y1, y2, y3, y4 : integer; // polygon vertices + bwide : integer; +// xoffset : integer; + +begin + bwide := round(BarWidth * XProp); + xoffset := round(bwide * cos(RadAngle)); + XAxisLength := XAxisLength - (NSets * xoffset); // new length of X Axis + XEnd := XStart + XAxisLength; + BarWidth := XAxisLength div NoBars; //Adjusted bar width + bwide := round(BarWidth * XProp); + xoffset := round(bwide * cos(RadAngle)); + deep := xoffset * NSets; + triheight := round(bwide * sin(RadAngle) * NSets); // total height of additional y needed + triheight := triheight div 2; // scale down depth of view + YAxisLength := YAxisLength - triheight; + YEnd := YStart - YAxisLength; + // do left wall + x1 := XStart; + x2 := x1 + deep; + y1 := YStart; + y2 := YStart - triheight; + y3 := YStart - YAxisLength - triheight; + y4 := YEnd; + Printer.Canvas.Brush.Color := WallColor; + Printer.Canvas.Polygon([Point(x1,y1),Point(x2,y2),Point(x2,y3),Point(x1,y4)]); + // do floor + x1 := XStart; + x2 := XStart + deep; + x3 := XEnd; + x4 := XEnd + deep; + y1 := YStart; + y2 := YStart - triheight; + Printer.Canvas.Brush.Color := FloorColor; + Printer.Canvas.Polygon([Point(x1,y1),Point(x3,y1),Point(x4,y2),Point(x2,y2)]); +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pBar2D(Sender: TObject); +var + j : integer; + x1, y1, x2, y2 : integer; + bwidth : integer; + xpos : integer; + yprop : real; + ydist : real; +begin + pMakeXAxis(self); + pMakeYAxis(self); + { Make bar for each y data point } + for j := 1 to NoBars do + begin + Printer.Canvas.Brush.Color := Colors[j mod 12]; + bwidth := round(XProp * BarWidth); + xpos := XStart + (BarWidth * j) - (BarWidth div 2); + x1 := xpos - (bwidth div 2); + x2 := x1 + bwidth; + y1 := YStart; + yprop := (YPoints[0,j-1] - YMin) / (YMax - YMin); + ydist := yprop * YAxisLength; + y2 := YStart - round(ydist); + Printer.Canvas.Polygon([Point(x1,y1),Point(x2,y1),Point(x2,y2),Point(x1,y2)]); + end; +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pBar3D(Sender: TObject); +var + i, j : integer; + x1, x2, x3, x4, y1, y2, y3, y4 : integer; + triheight : integer; + bwidth : integer; + yprop : real; +// yoffset : integer; +// xoffset : integer; + xpos : integer; + ydist : integer; + triwidth : integer; + +begin + pWalls(self); // create left and bottom wall and axes + Printer.Canvas.Brush.Color := BackColor; + pMakeXAxis(self); + pMakeYAxis(self); + bwidth := round(XProp * BarWidth); + triwidth := round(bwidth * cos(RadAngle)); + triheight := round(bwidth * sin(RadAngle)); + triheight := triheight div 2; // scale down depth of view + for i := NSets downto 1 do + begin + xoffset := triwidth * (i - 1); + yoffset := triheight * (i - 1); + for j := 1 to NoBars do + begin + Printer.Canvas.Brush.Color := Colors[j mod 12]; + xpos := XStart + (BarWidth * j) - (BarWidth div 2); + x1 := xpos - (bwidth div 2); + x2 := x1 + bwidth; + y1 := YStart; + yprop := (YPoints[i-1,j-1] - YMin) / (YMax - YMin); + ydist := round(yprop * YAxisLength); + y2 := YStart - round(ydist); + x1 := x1 + xoffset; + x2 := x2 + xoffset; + y1 := y1 - yoffset; + y2 := y2 - yoffset; + // draw face + Printer.Canvas.Polygon([Point(x1,y1),Point(x2,y1),Point(x2,y2),Point(x1,y2)]); + // draw side + x1 := x2; + x2 := x1 + triwidth; + y2 := y1 - triheight; + y3 := y1 - round(ydist); + y4 := y2 - round(ydist); + Printer.Canvas.Polygon([Point(x1,y1),Point(x2,y2),Point(x2,y4),Point(x1,y3)]); + // draw top + x1 := xpos - (bwidth div 2) + xoffset; + x2 := x1 + bwidth; + x3 := x2 + triwidth; + x4 := x1 + triwidth; + y1 := YStart - yoffset - round(ydist); + y2 := y1 - triheight; + Printer.Canvas.Polygon([Point(x1,y1),Point(x2,y1),Point(x3,y2),Point(x4,y2)]); + end; + x1 := XStart + XAxisLength + xoffset; + y1 := YStart - triheight * i; + Printer.Canvas.Brush.Color := clWhite; + Printer.Canvas.TextOut(x1,y1,SetLabels[i]); + end; +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pPie2D(Sender: TObject); +var + i : integer; + x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6 : integer; + yprop : real; + xcenter, ycenter : double; + Total : double; + radians : double; + radius : integer; + cum : double; + value : string; + +begin + xcenter := ImageWidth div 2; + ycenter := ImageHeight div 2; + + // get the total for obtaining proportions that each y point is of the total + Total := 0.0; + cum := 0.0; + radius := round(ycenter) - YOffset; + x1 := ImageWidth div 2 - Printer.Canvas.TextWidth(XTitle) div 2; + Printer.Canvas.TextOut(x1,YStart + 25,XTitle); + x1 := round(xcenter-radius); // left of rectangle + y1 := round(ycenter-radius); // top of rectangle + x2 := round(xcenter + radius); // right of rectangle + y2 := round(ycenter + radius); // bottom of rectangle + x3 := x2; + y3 := round(ycenter); + for i := 1 to NoBars do Total := Total + YPoints[0,i-1]; + // plot an arc corresponding to each proportion starting at radian 0 + for i := 1 to NoBars do + begin + yprop := YPoints[0,i-1] / Total; + cum := cum + yprop; + radians := cum * 2.0 * Pi; + x4 := round(xcenter + radius * cos(radians)); + y4 := round(ycenter - (radius * sin(radians))); + Printer.Canvas.Brush.Color := Colors[i mod 12]; + if yprop > 0.0 then + begin + Printer.Canvas.Pie(x1,y1,x2,y2,x3,y3,x4,y4); + radians := (cum - (yprop / 2.0)) * 2.0 * Pi; + x5 := round(xcenter + radius * cos(radians)); + y5 := round(ycenter - radius * sin(radians)); + Printer.Canvas.MoveTo(x5,y5); + if x5 >= round(xcenter) then x6 := x5 + 50 + else x6 := x5 - 50; + if y5 >= round(ycenter) then y6 := y5 + 50 + else y6 := y5 - 50; + Printer.Canvas.LineTo(x6,y6); + Printer.Canvas.Brush.Color := BackColor; + value := format('%8.5g',[XPoints[0,i-1]]); + Printer.Canvas.TextOut(x6,y6,value); + if x5 >= round(xcenter) then x6 := x5 - 50 + else x6 := x5 + 50; + if y5 >= round(ycenter) then y6 := y5 - 50 + else y6 := y5 + 50; + value := format('%4.2f',[yprop*100.0]); + value := value + '%'; + Printer.Canvas.TextOut(x6,y6,value); + x3 := x4; + y3 := y4; + end; + end; +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pExPie(Sender: TObject); +var + i : integer; + x1, y1, x2, y2, x3, y3, x4, y4, x5, y5, x6, y6 : integer; + yprop : real; + xcenter, ycenter : double; + Total : double; + radians : double; + midradians : double; + radius : integer; + cum : double; + value : string; + +begin + ycenter := ImageHeight div 2; + // get the total for obtaining proportions that each y point is of the total + Total := 0.0; + cum := 0.0; + radius := round(ycenter) - YOffset; + x1 := ImageWidth div 2 - Printer.Canvas.TextWidth(XTitle) div 2; + Printer.Canvas.TextOut(x1,YStart + 25,XTitle); + for i := 1 to NoBars do Total := Total + YPoints[0,i-1]; + // plot an arc corresponding to each proportion starting at radian 0 + for i := 1 to NoBars do + begin + xcenter := ImageWidth div 2; + ycenter := ImageHeight div 2; + yprop := YPoints[0,i-1] / Total; + cum := cum + yprop; + radians := cum * 2.0 * Pi; + midradians := (cum - (yprop / 2.0)) * 2.0 * Pi; + x5 := round(xcenter + radius * cos(midradians)); + y5 := round(ycenter - radius * sin(midradians)); + // explode pie by shifting slices away from center + if x5 >= round(xcenter) then xcenter := xcenter + 10 + else xcenter := xcenter - 10; + if y5 >= round(ycenter) then ycenter := ycenter + 10 + else ycenter := ycenter - 10; + x1 := round(xcenter-radius); // left of rectangle + y1 := round(ycenter-radius); // top of rectangle + x2 := round(xcenter + radius); // right of rectangle + y2 := round(ycenter + radius); // bottom of rectangle + midradians := (cum - yprop ) * 2.0 * Pi; + x3 := round(xcenter + radius * cos(midradians)); + y3 := round(ycenter - radius * sin(midradians)); + x4 := round(xcenter + radius * cos(radians)); + y4 := round(ycenter - (radius * sin(radians))); + Printer.Canvas.Brush.Color := Colors[i mod 12]; + if yprop > 0.0 then + begin + Printer.Canvas.Pie(x1,y1,x2,y2,x3,y3,x4,y4); + radians := (cum - (yprop / 2.0)) * 2.0 * Pi; + x5 := round(xcenter + radius * cos(radians)); + y5 := round(ycenter - radius * sin(radians)); + Printer.Canvas.MoveTo(x5,y5); + if x5 >= round(xcenter) then x6 := x5 + 50 + else x6 := x5 - 50; + if y5 >= round(ycenter) then y6 := y5 + 50 + else y6 := y5 - 50; + Printer.Canvas.LineTo(x6,y6); + Printer.Canvas.Brush.Color := BackColor; + value := format('%8.5g',[XPoints[0,i-1]]); + Printer.Canvas.TextOut(x6,y6,value); + if x5 >= round(xcenter) then x6 := x5 - 50 + else x6 := x5 + 50; + if y5 >= round(ycenter) then y6 := y5 - 50 + else y6 := y5 + 50; + value := format('%4.2f',[yprop*100.0]); + value := value + '%'; + Printer.Canvas.TextOut(x6,y6,value); + end; + end; +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pLine2D(Sender: TObject); +var + i, j : integer; + x1, y1, x2, y2 : integer; + xpos : integer; + yprop : real; + ydist : real; +begin + pMakeXAxis(self); + pMakeYAxis(self); + { Make lines for each set of y data point } + For i := 1 to NSets do + begin + Printer.Canvas.Brush.Color := Colors[i mod 12]; + x1 := XStart + BarWidth div 2; + yprop := (YPoints[i-1,0] - YMin) / (YMax - YMin); + ydist := yprop * YAxisLength; + y1 := YStart - round(ydist); + Printer.Canvas.MoveTo(x1,y1); + for j := 2 to NoBars do + begin + xpos := XStart + (BarWidth * j) - (BarWidth div 2); + x2 := xpos; + yprop := (YPoints[i-1,j-1] - YMin) / (YMax - YMin); + ydist := yprop * YAxisLength; + y2 := YStart - round(ydist); + Printer.Canvas.LineTo(x2,y2); + end; + end; +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pLine3D(Sender: TObject); +var + i, j : integer; + x1, x2, y1, y2 : integer; + triheight : integer; + bwidth : integer; + yprop : real; +// yoffset : integer; +// xoffset : integer; + xpos : integer; + ydist : integer; + triwidth : integer; + +begin + pWalls(self); // create left and bottom wall and axes + Printer.Canvas.Brush.Color := BackColor; + pMakeXAxis(self); + pMakeYAxis(self); + XProp := 1.0; + bwidth := round(XProp * BarWidth); + triwidth := round(bwidth * cos(RadAngle)); + triheight := round(bwidth * sin(RadAngle)); + triheight := triheight div 2; // scale down depth of view + for i := NSets downto 1 do + begin + xoffset := triwidth * (i - 1); + yoffset := triheight * (i - 1); + for j := 1 to NoBars do + begin + //Image1.Canvas.Brush.Color := Colors[j mod 12]; + Printer.Canvas.Pen.Color := Colors[i mod 12]; + xpos := XStart + (BarWidth * j) - (BarWidth div 2); + x1 := xpos - (bwidth div 2); + x2 := x1 + bwidth; + y1 := YStart; + yprop := (YPoints[i-1,j-1] - YMin) / (YMax - YMin); + ydist := round(yprop * YAxisLength); + y2 := YStart - round(ydist); + x1 := x1 + xoffset; + x2 := x2 + xoffset; + y1 := y1 - yoffset; + y2 := y2 - yoffset; + Printer.Canvas.MoveTo(x1,y1); + Printer.Canvas.LineTo(x2,y2); + end; + Printer.Canvas.Pen.Color := clBlack; + x1 := XStart + XAxisLength + xoffset; + y1 := YStart - triheight * i; + Printer.Canvas.Brush.Color := clWhite; + Printer.Canvas.TextOut(x1,y1,SetLabels[i]); + end; +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pPlot2D(Sender: TObject); +var + i, j : integer; + x1, y1 : integer; + triheight : integer; + bwidth : integer; + yprop : real; +// yoffset : integer; +// xoffset : integer; + xpos : integer; + ydist : integer; + triwidth : integer; +begin + pWalls(self); // create left and bottom wall and axes + Printer.Canvas.Brush.Color := BackColor; + pMakeXAxis(self); + pMakeYAxis(self); + bwidth := round(XProp * BarWidth); + triwidth := round(bwidth * cos(RadAngle)); + triheight := round(bwidth * sin(RadAngle)); + triheight := triheight div 2; // scale down depth of view + { Make points for each set of y data point } + for i := NSets downto 1 do + begin + Printer.Canvas.Brush.Color := Colors[i mod 12]; + xoffset := triwidth * (i - 1); + yoffset := triheight * (i - 1); + for j := 1 to NoBars do + begin + xpos := XStart + (BarWidth * j) - (BarWidth div 2); + x1 := xpos; + yprop := (YPoints[i-1,j-1] - YMin) / (YMax - YMin); + ydist := round(yprop * YAxisLength); + y1 := YStart - round(ydist); + x1 := x1 + xoffset; + y1 := y1 - yoffset; + if PtLabels then + begin + Printer.Canvas.Brush.Color := BackColor; + Printer.Canvas.TextOut(x1,y1,PointLabels[j]); + end + else + Printer.Canvas.Ellipse(x1-5,y1-5,x1+5,y1+5); + end; + Printer.Canvas.Pen.Color := clBlack; + x1 := XStart + XAxisLength + xoffset; + y1 := YStart - triheight * i; + Printer.Canvas.Brush.Color := clWhite; + Printer.Canvas.TextOut(x1,y1,SetLabels[i]); + end; +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pPlot3D(Sender: TObject); +var + i, j : integer; + x1, y1 : integer; + yprop : real; + triheight : integer; + bwidth : integer; +// yoffset : integer; +// xoffset : integer; + xpos : integer; + ydist : integer; + triwidth : integer; +begin + pWalls(self); // create left and bottom wall and axes + Printer.Canvas.Brush.Color := BackColor; + pMakeXAxis(self); + pMakeYAxis(self); + bwidth := round(XProp * BarWidth); + triwidth := round(bwidth * cos(RadAngle)); + triheight := round(bwidth * sin(RadAngle)); + triheight := triheight div 2; // scale down depth of view + { Make points for each set of y data point } + for i := NSets downto 1 do + begin + Printer.Canvas.Brush.Color := Colors[i mod 12]; + xoffset := triwidth * (i - 1); + yoffset := triheight * (i - 1); + for j := 1 to NoBars do + begin + xpos := XStart + (BarWidth * j) - (BarWidth div 2); + x1 := xpos; + yprop := (YPoints[i-1,j-1] - YMin) / (YMax - YMin); + ydist := round(yprop * YAxisLength); + y1 := YStart - round(ydist); + x1 := x1 + xoffset; + y1 := y1 - yoffset; + // change next to a ball by drawing multiple Ellipses around + // vertical axis ? + Printer.Canvas.Ellipse(x1-5,y1-5,x1+5,y1+5); + Printer.Canvas.Ellipse(x1-4,y1-5,x1+4,y1+5); + Printer.Canvas.Ellipse(x1-3,y1-5,x1+3,y1+5); + Printer.Canvas.Ellipse(x1-2,y1-5,x1+2,y1+5); + end; + Printer.Canvas.Pen.Color := clBlack; + x1 := XStart + XAxisLength + xoffset; + y1 := YStart - triheight * i; + Printer.Canvas.Brush.Color := clWhite; + Printer.Canvas.TextOut(x1,y1,SetLabels[i]); + end; +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pMakeXAxis(Sender: TObject); +var + i, valstart, valend, oldend : integer; + xpos : integer; + value : string; +begin + Printer.Canvas.MoveTo(XStart,YStart); + Printer.Canvas.LineTo(XEnd,YStart); + oldend := 0; + for i := 1 to NoBars do + begin + xpos := XStart + (BarWidth * i) - (BarWidth div 2); + Printer.Canvas.MoveTo(xpos,YStart); + Printer.Canvas.LineTo(xpos,YStart + 5); + value := format('%6.5g',[XPoints[0,i-1]]); + valstart := xpos - Printer.Canvas.TextWidth(value) div 2; + valend := valstart + Printer.Canvas.TextWidth(value); + if valstart > oldend then + begin + Printer.Canvas.TextOut(valstart,YStart + 10,value); + oldend := valend; + end; + end; + xpos := ImageWidth div 2 - Printer.Canvas.TextWidth(XTitle) div 2; + Printer.Canvas.TextOut(xpos,YStart + 100,XTitle); +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pMakeYaxis(Sender: TObject); +var + ypos : integer; + i : integer; + incr : real; + value : real; + valstring : string; + +begin + Printer.Canvas.MoveTo(XStart,YStart); + Printer.Canvas.LineTo(XStart,YEnd); + incr := (YMax - YMin) / 20.0; + for i := 1 to 21 do + begin + value := YMin + (incr * (i-1)); + ypos := YStart - ((i-1) * YAxisLength div 20); + Printer.Canvas.MoveTo(XStart,ypos); + Printer.Canvas.LineTo(XStart-10,ypos); + valstring := format('%10.2f',[value]); + Printer.Canvas.TextOut(XStart - 10 - Printer.Canvas.TextWidth(valstring),ypos,valstring); + end; + ypos := YEnd - 10 - Printer.Canvas.TextHeight(YTitle); + Printer.Canvas.TextOut(100,ypos,YTitle); +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pMakeHXaxis(Sender: TObject); +var + xpos : integer; + i : integer; + incr : real; + value : real; + valstring : string; + +begin + Printer.Canvas.MoveTo(XStart,YStart); + Printer.Canvas.LineTo(XEnd,YStart); + incr := (YMax - YMin) / 20.0; + for i := 1 to 21 do + begin + value := YMin + (incr * (i-1)); + xpos := XStart + ((i-1) * XAxisLength div 20); + Printer.Canvas.MoveTo(xpos,YStart); + Printer.Canvas.LineTo(xpos,YStart + 5); + valstring := format('%8.2f',[value]); + Printer.Canvas.TextOut(xpos - Printer.Canvas.TextWidth(valstring) div 2, + YStart + 10,FloatToStr(value)); + end; + xpos := XAxisLength div 2 - Printer.Canvas.TextWidth(YTitle) div 2; + Printer.Canvas.TextOut(xpos,YStart + 100,YTitle); +end; +//----------------------------------------------------------------------- +procedure TGraphFrm.pMakeHYaxis(Sender: TObject); +var + i : integer; + ypos : integer; + value : string; +begin + Printer.Canvas.MoveTo(XStart,YStart); + Printer.Canvas.LineTo(XStart,YEnd); + for i := 1 to NoBars do + begin + ypos := YStart - (BarWidth * i) + (BarWidth div 2); + Printer.Canvas.MoveTo(XStart,ypos); + Printer.Canvas.LineTo(XStart - 10,ypos); + value := format('%6.5g',[XPoints[0,i-1]]); + Printer.Canvas.TextOut(XStart-10-Printer.Canvas.TextWidth(value), + ypos,value); + end; + ypos := YEnd; + Printer.Canvas.TextOut(100,ypos,XTitle); +end; +//----------------------------------------------------------------------- + +initialization + {$I graphlib.lrs} + +end. + diff --git a/applications/lazstats/source/forms/misc/licenseunit.lfm b/applications/lazstats/source/forms/misc/licenseunit.lfm new file mode 100644 index 000000000..1c504581e --- /dev/null +++ b/applications/lazstats/source/forms/misc/licenseunit.lfm @@ -0,0 +1,117 @@ +object LicenseFrm: TLicenseFrm + Left = 138 + Height = 347 + Top = 105 + Width = 637 + Caption = 'License For Use' + ClientHeight = 347 + ClientWidth = 637 + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Memo1: TMemo + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 289 + Top = 8 + Width = 621 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -13 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + Lines.Strings = ( + ' ***************************************************************************' + ' * *' + ' * This source 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 2 of the License, or *' + ' * (at your option) any later version. *' + ' * *' + ' * This code 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. *' + ' * *' + ' * A copy of the GNU General Public License is available on the World *' + ' * Wide Web at . You can also *' + ' * obtain it by writing to the Free Software Foundation, *' + ' * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *' + ' * *' + ' ***************************************************************************' + '' + 'Use at your own risk. Compare results to other statistics programs' + 'or text book examples for each procedure.' + 'Click on Accept or Reject below.' + ) + ParentFont = False + TabOrder = 0 + end + object Panel1: TPanel + Left = 8 + Height = 26 + Top = 313 + Width = 621 + Align = alBottom + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 26 + ClientWidth = 621 + TabOrder = 1 + object AcceptBtn: TButton + AnchorSideRight.Control = Bevel2 + Left = 239 + Height = 25 + Top = 0 + Width = 63 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Accept' + ModalResult = 1 + TabOrder = 0 + end + object RejectBtn: TButton + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 318 + Height = 25 + Top = 1 + Width = 58 + AutoSize = True + Caption = 'Reject' + ModalResult = 2 + TabOrder = 1 + end + object Bevel2: TBevel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + Left = 302 + Height = 19 + Top = 4 + Width = 16 + Shape = bsSpacer + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + Left = 0 + Height = 8 + Top = 297 + Width = 637 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/misc/licenseunit.pas b/applications/lazstats/source/forms/misc/licenseunit.pas new file mode 100644 index 000000000..96808b95c --- /dev/null +++ b/applications/lazstats/source/forms/misc/licenseunit.pas @@ -0,0 +1,53 @@ +unit LicenseUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls; + +type + + { TLicenseFrm } + + TLicenseFrm = class(TForm) + AcceptBtn: TButton; + Bevel1: TBevel; + Bevel2: TBevel; + RejectBtn: TButton; + Memo1: TMemo; + Panel1: TPanel; + private + { private declarations } + public + { public declarations } + end; + +var + LicenseFrm: TLicenseFrm; + +function AcceptLicenseForm: Boolean; + + +implementation + +function AcceptLicenseForm: Boolean; +begin + with TLicenseFrm.Create(nil) do + try + Result := (ShowModal = mrOK); + finally + Free; + end; +end; + + +{ TLicenseFrm } + +initialization + {$I licenseunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/misc/outputunit.lfm b/applications/lazstats/source/forms/misc/outputunit.lfm new file mode 100644 index 000000000..8629c1706 --- /dev/null +++ b/applications/lazstats/source/forms/misc/outputunit.lfm @@ -0,0 +1,179 @@ +object OutputFrm: TOutputFrm + Left = 396 + Height = 535 + Top = 159 + Width = 754 + Caption = 'Output' + ClientHeight = 535 + ClientWidth = 754 + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Pitch = fpFixed + Font.Quality = fqDraft + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Panel1: TPanel + Left = 0 + Height = 41 + Top = 0 + Width = 754 + Align = alTop + AutoSize = True + BevelOuter = bvNone + ClientHeight = 41 + ClientWidth = 754 + TabOrder = 0 + object SaveFileBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 8 + Height = 25 + Top = 8 + Width = 50 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + Caption = 'Save' + OnClick = SaveFileBtnClick + TabOrder = 0 + end + object OpenFileBtn: TButton + AnchorSideLeft.Control = SaveFileBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SaveFileBtn + Left = 74 + Height = 25 + Top = 8 + Width = 76 + AutoSize = True + BorderSpacing.Left = 16 + Caption = 'Open File' + OnClick = OpenFileBtnClick + TabOrder = 1 + end + object FontBtn: TButton + AnchorSideLeft.Control = OpenFileBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SaveFileBtn + Left = 174 + Height = 25 + Top = 8 + Width = 50 + AutoSize = True + BorderSpacing.Left = 24 + Caption = 'Font' + OnClick = FontBtnClick + TabOrder = 2 + end + object CutBtn: TButton + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SaveFileBtn + AnchorSideRight.Control = CopyBtn + Left = 297 + Height = 25 + Top = 8 + Width = 45 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Cut' + OnClick = CutBtnClick + TabOrder = 3 + end + object CopyBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = SaveFileBtn + Left = 350 + Height = 25 + Top = 8 + Width = 54 + AutoSize = True + Caption = 'Copy' + OnClick = CopyBtnClick + TabOrder = 4 + end + object PasteBtn: TButton + AnchorSideLeft.Control = CopyBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SaveFileBtn + Left = 412 + Height = 25 + Top = 8 + Width = 54 + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Paste' + OnClick = PasteBtnClick + TabOrder = 5 + end + object PrintBtn: TButton + AnchorSideTop.Control = SaveFileBtn + AnchorSideRight.Control = ReturnBtn + Left = 626 + Height = 25 + Top = 8 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Print' + OnClick = PrintBtnClick + TabOrder = 6 + end + object ReturnBtn: TButton + AnchorSideTop.Control = SaveFileBtn + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 685 + Height = 25 + Top = 8 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 7 + end + end + object RichEdit: TMemo + Left = 8 + Height = 486 + Top = 41 + Width = 738 + Align = alClient + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -13 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + Font.Quality = fqDraft + ParentFont = False + ScrollBars = ssBoth + TabOrder = 1 + end + object OpenDialog: TOpenDialog + left = 112 + top = 72 + end + object SaveDialog: TSaveDialog + left = 24 + top = 72 + end + object FontDialog: TFontDialog + MinFontSize = 0 + MaxFontSize = 0 + left = 192 + top = 72 + end + object PrintDialog: TPrintDialog + left = 640 + top = 72 + end +end diff --git a/applications/lazstats/source/forms/misc/outputunit.pas b/applications/lazstats/source/forms/misc/outputunit.pas new file mode 100644 index 000000000..f6f9972b6 --- /dev/null +++ b/applications/lazstats/source/forms/misc/outputunit.pas @@ -0,0 +1,262 @@ +unit OutputUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, Buttons, StdCtrls, Printers, clipbrd, PrintersDlgs; + +type + + { TOutputFrm } + + TOutputFrm = class(TForm) + PrintDialog: TPrintDialog; + RichEdit: TMemo; + ReturnBtn: TButton; + PrintBtn: TButton; + PasteBtn: TButton; + CopyBtn: TButton; + CutBtn: TButton; + FontBtn: TButton; + FontDialog: TFontDialog; + OpenFileBtn: TButton; + SaveFileBtn: TButton; + OpenDialog: TOpenDialog; + Panel1: TPanel; + SaveDialog: TSaveDialog; + procedure CopyBtnClick(Sender: TObject); + procedure CutBtnClick(Sender: TObject); + procedure FontBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure OpenFileBtnClick(Sender: TObject); + procedure PasteBtnClick(Sender: TObject); + procedure PrintBtnClick(Sender: TObject); + procedure SaveFileBtnClick(Sender: TObject); + private + { private declarations } + FPrintY: Integer; + procedure PrintText; + public + { public declarations } + procedure AddLine(const ALine: String); overload; + procedure AddLine(const Fmt: String; const Args: array of const); overload; + procedure AddLines(AList: TStrings); + procedure Clear; + end; + +var + OutputFrm: TOutputFrm; + +procedure DisplayReport(AReport: TStrings); + + +implementation + +const + LEFT_MARGIN = 200; + RIGHT_MARGIN = 200; + TOP_MARGIN = 150; + BOTTOM_MARGIN = 200; + +procedure DisplayReport(AReport: TStrings); +begin + if OutputFrm = nil then + OutputFrm := TOutputFrm.Create(Application) + else + OutputFrm.Clear; + OutputFrm.AddLines(AReport); + OutputFrm.ShowModal; +end; + + +{ TOutputFrm } + +procedure TOutputFrm.AddLine(const ALine: String); +begin + RichEdit.Lines.Add(ALine); +end; + +procedure TOutputFrm.AddLine(const Fmt: String; const Args: array of const); +begin + RichEdit.Lines.Add(Format(Fmt, Args)); +end; + +procedure TOutputFrm.AddLines(AList: TStrings); +begin + RichEdit.Lines.AddStrings(AList); +end; + +procedure TOutputFrm.Clear; +begin + RichEdit.Clear; +end; + +procedure TOutputFrm.PrintText; +var + i: Integer; + x: Integer; + xmax, ymax: Integer; + pageNo: Integer; + oldFontSize: Integer; + h: Integer; +begin + with Printer do + begin + x := LEFT_MARGIN; + FPrintY := TOP_MARGIN; + xMax := PaperSize.Width - RIGHT_MARGIN; + yMax := PaperSize.Height - BOTTOM_MARGIN; + pageNo := 1; + try + Canvas.Brush.Style := bsClear; // no text background color + Canvas.Font.Assign(RichEdit.Font); + if Canvas.Font.Size = 0 then + Canvas.Font.Size := 10; + oldFontSize := Canvas.Font.Size; + for i:=0 to RichEdit.Lines.Count-1 do begin + // Print page number + if FPrintY = TOP_MARGIN then begin + Canvas.Font.Size := 10; + h := Canvas.TextHeight('Page 9') + 4; + Canvas.TextOut(x+1, FPrintY, 'Page ' + IntToStr(PageNo)); + Canvas.Pen.Width := 3; + Canvas.Line(LEFT_MARGIN, FPrintY+h, xmax, FPrintY+h); + inc(FPrintY, 2*h); + Canvas.Font.Size := oldFontSize; + end; + Canvas.TextOut(x, FPrintY, RichEdit.Lines[i]); + inc(FPrintY, Canvas.TextHeight('Tg')); + if FPrintY > yMax then begin + NewPage; + FPrintY := TOP_MARGIN; + inc(PageNo); + end; + end; + except + on E: EPrinter do ShowMessage('Printer Error: ' + E.Message); + on E: Exception do showMessage('Unexpected error when printing.'); + end; + end; +end; + +procedure TOutputFrm.PrintBtnClick(Sender: TObject); +begin + if PrintDialog.Execute then + begin + Printer.BeginDoc; + try + PrintText; + finally + Printer.EndDoc; + end; + end; +end; + +(* +procedure TOutputFrm.PrintBtnClick(Sender: TObject); +var + aline: string; + NoLines, i, X, Y, txthi : integer; +begin + Printer.Orientation := poPortrait; + NoLines := OutputFrm.RichEdit.Lines.Count; + X := 5; // left margin + Y := 5; // top margin + PrintDialog.MinPage := 1; + PrintDialog.MaxPage := 1; + PrintDialog.ToPage := 1; + PrintDialog.Options := [poPageNums]; + Printer.Copies := PrintDialog.Copies; + if FontDialog.Execute then + begin + Printer.Canvas.Font := FontDialog.Font; + Printer.Canvas.Font.Height := FontDialog.Font.Height; + end; + if PrintDialog.Execute then + begin +// Printer.Canvas.Font.Height := 50; + Printer.Canvas.Font.Height := Printer.PageHeight div 80; + txthi := Printer.Canvas.Font.Height; + Printer.BeginDoc; + for i := 0 to NoLines-1 do + begin + aline := OutputFrm.RichEdit.Lines[i]; + Printer.Canvas.TextOut(X,Y,aline); +// txthi := Printer.Canvas.Font.Height; + Y := Y + abs(txthi); + if Y >= Printer.PageHeight - 10 then + begin + Printer.NewPage; + Y := 5; + end; + end; + Printer.EndDoc; + end; +end; +*) + +procedure TOutputFrm.OpenFileBtnClick(Sender: TObject); +begin + OpenDialog.Filter := 'LazStats text files (*.txt)|*.txt;*.TXT|All files (*.*)|*.*'; + OpenDialog.FilterIndex := 1; {text file} + if OpenDialog.Execute then + RichEdit.Lines.LoadFromFile(OpenDialog.FileName); +end; + +procedure TOutputFrm.CopyBtnClick(Sender: TObject); +begin + with RichEdit do + begin + SelectAll; + CopyToClipboard; + SelLength := 0; + end; +end; + +procedure TOutputFrm.CutBtnClick(Sender: TObject); +begin + RIchEdit.CutToClipboard; +end; + +procedure TOutputFrm.PasteBtnClick(Sender: TObject); +begin + RichEdit.PasteFromClipboard; +end; + +procedure TOutputFrm.FontBtnClick(Sender: TObject); +begin + FontDialog.Execute; + RichEdit.Font := FontDialog.Font; +end; + +procedure TOutputFrm.FormShow(Sender: TObject); +var + w: Integer; + i: Integer; +begin + w := 0; + for i := 0 to Panel1.ControlCount-1 do + if Panel1.Controls[i] is TButton then + if w > TButton(Panel1.Controls[i]).Width then + w := TButton(Panel1.Controls[i]).Width; + for i := 0 to Panel1.ControlCount-1 do + if Panel1.Controls[i] is TButton then + Panel1.Controls[i].Constraints.MinWidth := w; +end; + +procedure TOutputFrm.SaveFileBtnClick(Sender: TObject); +begin + SaveDialog.Filter := 'LazStats text files (*.txt)|*.txt;*.TXT|All files (*.*)|*.*'; + SaveDialog.FilterIndex := 1; {text file} + SaveDialog.Title := 'Print to File: '; + if SaveDialog.Execute then RichEdit.Lines.SaveToFile(SaveDialog.FileName); +end; + +initialization + {$I outputunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/options/optionsunit.lfm b/applications/lazstats/source/forms/options/optionsunit.lfm new file mode 100644 index 000000000..8a0330003 --- /dev/null +++ b/applications/lazstats/source/forms/options/optionsunit.lfm @@ -0,0 +1,240 @@ +object OptionsFrm: TOptionsFrm + Left = 510 + Height = 320 + Top = 266 + Width = 352 + AutoSize = True + Caption = 'Options' + ClientHeight = 320 + ClientWidth = 352 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = JustificationGrp + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 218 + Width = 108 + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + Caption = 'Default File Location' + ParentColor = False + end + object FractionTypeGrp: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 72 + Top = 8 + Width = 336 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Decimal Fraction Usage' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 332 + ItemIndex = 0 + Items.Strings = ( + 'English (default) period separator' + 'European (comma) separator' + ) + TabOrder = 0 + end + object MissValsGrp: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = FractionTypeGrp + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 51 + Top = 92 + Width = 336 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + Caption = 'Default Missing Values' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 12 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 4 + ClientHeight = 31 + ClientWidth = 332 + Columns = 4 + ItemIndex = 3 + Items.Strings = ( + 'Blank ' + 'Period ' + 'Zero (0) ' + '99999' + ) + TabOrder = 1 + end + object JustificationGrp: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = MissValsGrp + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 51 + Top = 155 + Width = 336 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + BorderSpacing.Right = 8 + Caption = 'Justification' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 12 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 3 + ClientHeight = 31 + ClientWidth = 332 + Columns = 3 + ItemIndex = 2 + Items.Strings = ( + 'Left' + 'Center' + 'Right' + ) + TabOrder = 2 + end + object FilePathEdit: TEdit + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 23 + Top = 235 + Width = 336 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 3 + end + object CancelBtn: TButton + AnchorSideTop.Control = HelpBtn + AnchorSideRight.Control = SaveBtn + Left = 169 + Height = 25 + Top = 281 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 4 + end + object SaveBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = HelpBtn + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 239 + Height = 25 + Top = 281 + Width = 105 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Save and Close' + ModalResult = 1 + OnClick = SaveBtnClick + TabOrder = 5 + end + object BrowseBtn: TButton + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = HelpBtn + AnchorSideRight.Control = CancelBtn + Left = 88 + Height = 25 + Top = 281 + Width = 73 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Browse...' + OnClick = BrowseBtnClick + TabOrder = 6 + end + object HelpBtn: TButton + Tag = 135 + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = BrowseBtn + Left = 29 + Height = 25 + Top = 281 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 7 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = FilePathEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 3 + Top = 270 + Width = 352 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 12 + Shape = bsBottomLine + end + object SelDir: TSelectDirectoryDialog + left = 184 + top = 184 + end +end diff --git a/applications/lazstats/source/forms/options/optionsunit.pas b/applications/lazstats/source/forms/options/optionsunit.pas new file mode 100644 index 000000000..44ac3bda3 --- /dev/null +++ b/applications/lazstats/source/forms/options/optionsunit.pas @@ -0,0 +1,210 @@ +unit OptionsUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Clipbrd, + Globals, ContextHelpUnit; + +type + + { TOptionsFrm } + + TOptionsFrm = class(TForm) + Bevel1: TBevel; + BrowseBtn: TButton; + CancelBtn: TButton; + HelpBtn: TButton; + SaveBtn: TButton; + FilePathEdit: TEdit; + Label1: TLabel; + FractionTypeGrp: TRadioGroup; + MissValsGrp: TRadioGroup; + JustificationGrp: TRadioGroup; + SelDir: TSelectDirectoryDialog; + procedure BrowseBtnClick(Sender: TObject); + procedure CancelBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure SaveBtnClick(Sender: TObject); + + private + { private declarations } + FAutoSized: Boolean; + FSavedOptions: TOptions; + public + { public declarations } + procedure ControlsToOptions(var AOptions: TOptions); + procedure OptionsToControls(const AOptions: TOptions); + end; + +var + OptionsFrm: TOptionsFrm; + +procedure LoadOptions; +procedure SaveOptions; + + +implementation + +uses + Math, LazFileUtils; + +const + OPTIONS_FILE = 'options.txt'; + +procedure LoadOptions; +var + filename: String; + pathname: string; + F: TextFile; + i: integer; + approved: integer; +begin + filename := AppendPathDelim(OpenStatPath) + OPTIONS_FILE; + + if not FileExists(fileName) then + exit; + + AssignFile(F, fileName); + Reset(F); + + // approved + ReadLn(F, approved); + LoggedOn := (approved <> 0); + + // Fraction type + ReadLn(F, i); + Options.FractionType := TFractionType(i); + DefaultFormatSettings.DecimalSeparator := FractionTypeChars[Options.FractionType]; + + // Default missing value + ReadLn(F, i); + Options.DefaultMiss := TMissingValueCode(i); + + // Default justification + ReadLn(F, i); + Options.DefaultJust := TJustification(i); + + // Default path + ReadLn(F, pathName); + if (pathname = '') or (not DirectoryExists(pathname)) then + Options.DefaultPath := GetCurrentDir + else + Options.Defaultpath := pathname; + + Close(F); +end; + +procedure SaveOptions; +var + filename: string; + F: TextFile; + approved: integer; +begin + if LoggedOn then + approved := 1 + else + approved := 0; + + filename := AppendPathDelim(OpenStatPath) + OPTIONS_FILE; + AssignFile(F, fileName); + Rewrite(F); + WriteLn(F, approved); + WriteLn(F, ord(Options.FractionType)); + WriteLn(F, ord(Options.DefaultMiss)); + WriteLn(F, ord(Options.DefaultJust)); + WriteLn(F, Options.DefaultPath); + CloseFile(F); + + DefaultFormatSettings.DecimalSeparator := FractionTypeChars[Options.FractionType]; +end; + + +{ TOptionsFrm } + +procedure TOptionsFrm.ControlsToOptions(var AOptions: TOptions); +begin + AOptions.FractionType := TFractionType(FractionTypeGrp.ItemIndex); + AOptions.DefaultMiss := TMissingValueCode(MissValsGrp.ItemIndex); + AOptions.DefaultJust := TJustification(JustificationGrp.ItemIndex); + if FilePathEdit.Text = '' then + AOptions.DefaultPath := OpenStatPath + else + AOptions.DefaultPath := FilePathEdit.Text; +end; + +procedure TOptionsFrm.OptionsToControls(const AOptions: TOptions); +begin + FractionTypeGrp.ItemIndex := ord(AOptions.FractionType); + MissValsGrp.ItemIndex := Ord(AOptions.DefaultMiss); + JustificationGrp.ItemIndex := Ord(AOptions.DefaultJust); + if AOptions.DefaultPath = '' then + FilePathEdit.Text := OpenStatPath + else + FilePathEdit.Text := AOptions.DefaultPath; +end; + +procedure TOptionsFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, BrowseBtn.Width, SaveBtn.Width, CancelBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + BrowseBtn.Constraints.MinWidth := w; + SaveBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + Constraints.MaxHeight := Height; + + FAutoSized := true; +end; + +procedure TOptionsFrm.FormShow(Sender: TObject); +begin + OptionsToControls(Options); + ControlsToOptions(FSavedOptions); +end; + +procedure TOptionsFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TOptionsFrm.SaveBtnClick(Sender: TObject); +begin + ControlsToOptions(Options); + SaveOptions; +end; + +procedure TOptionsFrm.BrowseBtnClick(Sender: TObject); +begin + with SelDir do + begin + InitialDir := FilePathEdit.Text; + if Execute then + FilePathEdit.text := FileName; + end; +end; + +procedure TOptionsFrm.CancelBtnClick(Sender: TObject); +begin + Options := FSavedOptions; +end; + +initialization + {$I optionsunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/corsimunit.lfm b/applications/lazstats/source/forms/simulations/corsimunit.lfm new file mode 100644 index 000000000..e83739cba --- /dev/null +++ b/applications/lazstats/source/forms/simulations/corsimunit.lfm @@ -0,0 +1,223 @@ +object CorSimFrm: TCorSimFrm + Left = 542 + Height = 447 + Top = 126 + Width = 857 + Caption = 'Correlation Simulation' + ClientHeight = 447 + ClientWidth = 857 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Image1: TImage + Left = 8 + Height = 389 + Top = 8 + Width = 841 + Align = alClient + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + end + object Panel1: TPanel + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 26 + Top = 413 + Width = 841 + Align = alBottom + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 26 + ClientWidth = 841 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = MeanX + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 6 + Width = 43 + Caption = 'Mean X:' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = MeanX + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label1 + Left = 108 + Height = 15 + Top = 6 + Width = 43 + BorderSpacing.Left = 16 + Caption = 'Mean Y:' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = MeanY + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + Left = 221 + Height = 15 + Top = 6 + Width = 50 + BorderSpacing.Left = 16 + Caption = 'Std.Dev.X' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = SDX + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label3 + Left = 345 + Height = 15 + Top = 6 + Width = 50 + BorderSpacing.Left = 16 + Caption = 'Std.Dev.Y' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = SDY + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label4 + Left = 450 + Height = 15 + Top = 6 + Width = 36 + BorderSpacing.Left = 8 + Caption = 'Cor.XY' + ParentColor = False + end + object Label6: TLabel + AnchorSideLeft.Control = Corr + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label5 + AnchorSideTop.Side = asrCenter + Left = 554 + Height = 15 + Top = 6 + Width = 35 + BorderSpacing.Left = 16 + Caption = 'N Size:' + ParentColor = False + end + object MeanX: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 49 + Height = 23 + Top = 2 + Width = 43 + BorderSpacing.Left = 6 + OnKeyPress = MeanXKeyPress + TabOrder = 0 + Text = 'MeanX' + end + object MeanY: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = MeanX + Left = 159 + Height = 23 + Top = 2 + Width = 46 + BorderSpacing.Left = 8 + OnKeyPress = MeanYKeyPress + TabOrder = 1 + Text = 'MeanY' + end + object SDX: TEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = MeanY + Left = 279 + Height = 23 + Top = 2 + Width = 50 + BorderSpacing.Left = 8 + OnKeyPress = SDXKeyPress + TabOrder = 2 + Text = 'SDX' + end + object SDY: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SDX + Left = 403 + Height = 23 + Top = 2 + Width = 39 + BorderSpacing.Left = 8 + OnKeyPress = SDYKeyPress + TabOrder = 3 + Text = 'SDY' + end + object Corr: TEdit + AnchorSideLeft.Control = Label5 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SDY + Left = 494 + Height = 23 + Top = 2 + Width = 44 + BorderSpacing.Left = 8 + OnKeyPress = CorrKeyPress + TabOrder = 4 + Text = 'Corr' + end + object ComputeBtn: TButton + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ReturnBtn + Left = 702 + Height = 26 + Top = 0 + Width = 65 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 775 + Height = 26 + Top = 0 + Width = 66 + Anchors = [akTop, akRight] + Caption = 'Return' + ModalResult = 1 + TabOrder = 6 + end + object Nobs: TEdit + AnchorSideLeft.Control = Label6 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Corr + Left = 597 + Height = 23 + Top = 2 + Width = 40 + BorderSpacing.Left = 8 + OnKeyPress = NobsKeyPress + TabOrder = 7 + Text = 'Nobs' + end + end + object Bevel1: TBevel + Left = 0 + Height = 8 + Top = 397 + Width = 857 + Align = alBottom + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/simulations/corsimunit.pas b/applications/lazstats/source/forms/simulations/corsimunit.pas new file mode 100644 index 000000000..d3ecceba4 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/corsimunit.pas @@ -0,0 +1,379 @@ +unit CorSimUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, Math, + Globals, OutputUnit; + +type + + { TCorSimFrm } + + TCorSimFrm = class(TForm) + Bevel1: TBevel; + Nobs: TEdit; + Image1: TImage; + Label6: TLabel; + ReturnBtn: TButton; + ComputeBtn: TButton; + Corr: TEdit; + Label5: TLabel; + SDY: TEdit; + Label4: TLabel; + SDX: TEdit; + Label3: TLabel; + MeanY: TEdit; + Label2: TLabel; + MeanX: TEdit; + Label1: TLabel; + Panel1: TPanel; + procedure ComputeBtnClick(Sender: TObject); + procedure CorrKeyPress(Sender: TObject; var Key: char); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure MeanXKeyPress(Sender: TObject; var Key: char); + procedure MeanYKeyPress(Sender: TObject; var Key: char); + procedure NobsKeyPress(Sender: TObject; var Key: char); + procedure SDXKeyPress(Sender: TObject; var Key: char); + procedure SDYKeyPress(Sender: TObject; var Key: char); + private + { private declarations } + xmean, ymean, xsd, ysd, corxy, corsqr, yvariance, predvar : double; + errvariance, stderror, b, constant, newxmean, newymean : double; + newxsd, newysd, newcorr, randomerror, newb, newconstant : double; + x, y : DblDyneVec; + freqx, freqy : IntDyneVec; + N : integer; + procedure plot(Sender: TObject); + public + { public declarations } + end; + +var + CorSimFrm: TCorSimFrm; + +implementation + +{ TCorSimFrm } + +procedure TCorSimFrm.MeanXKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then MeanY.SetFocus; +end; + +procedure TCorSimFrm.CorrKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then Nobs.SetFocus; +end; + +procedure TCorSimFrm.FormCreate(Sender: TObject); +begin + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +procedure TCorSimFrm.ComputeBtnClick(Sender: TObject); +var + outline : string; + i : integer; +begin + N := StrToInt(NObs.Text); + xmean := StrToFloat(MeanX.Text); + ymean := StrToFloat(MeanY.Text); + xsd := StrToFloat(SDX.Text); + ysd := StrToFloat(SDY.Text); + corxy := StrToFloat(Corr.Text); + Randomize; + + SetLength(freqx,N + 1); + SetLength(freqy,N + 1); + SetLength(x,N + 1); + SetLength(y,N + 1); + + // generate x and y data observations + corsqr := corxy * corxy; + yvariance := ysd * ysd; + predvar := corsqr * yvariance; + errvariance := yvariance - predvar; + stderror := sqrt(errvariance); + b := corxy * (ysd / xsd); + constant := ymean - (b * xmean); + + newxmean := 0.0; + newymean := 0.0; + newxsd := 0.0; + newysd := 0.0; + newcorr := 0.0; + for i := 1 to N do + begin + x[i] := RandG(xmean,xsd); + randomerror := RandG(0.0,stderror); + y[i] := (b * x[i]) + constant + randomerror; + newxmean := newxmean + x[i]; + newymean := newymean + y[i]; + newxsd := newxsd + (x[i] * x[i]); + newysd := newysd + (y[i] * y[i]); + newcorr := newcorr + (x[i] * y[i]); + end; + newxsd := newxsd - ((newxmean * newxmean) / N); + newxsd := newxsd / (N - 1.0); + newxsd := sqrt(newxsd); + newysd := newysd - ((newymean * newymean) / N); + newysd := newysd / (N - 1.0); + newysd := sqrt(newysd); + newcorr := newcorr - ((newxmean * newymean) / N); + newcorr := newcorr / (N - 1.0); + newcorr := newcorr / (newxsd * newysd); + newxmean := newxmean / N; + newymean := newymean / N; + newb := newcorr * (newysd / newxsd); + newconstant := newymean - (newb * newxmean); + OutputFrm.RichEdit.Lines.Clear; + outline := 'POPULATION PARAMETERS FOR THE SIMULATION'; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Mean X := %8.3f, Std. Dev. X := %8.3f',[xmean, xsd]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Mean Y := %8.3f, Std. Dev. Y := %8.3f',[ymean, ysd]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Product-Moment Correlation := %8.3f',[corxy]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Regression line slope := %8.3f, constant := %8.3f', + [b, constant]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('SAMPLE STATISTICS FOR %d OBSERVATIONS FROM THE POPULATION',[N]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Mean X := %8.3f, Std. Dev. X := %8.3f',[newxmean, newxsd]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Mean Y := %8.3f, Std. Dev. Y := %8.3f',[newymean, newysd]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Product-Moment Correlation := %8.3f',[newcorr]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Regression line slope := %8.3f, constant := %8.3f', + [newb, newconstant]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Pair No. X Y'); + for i := 1 to N do + begin + outline := format(' %3d %9.3f %9.3f',[i,x[i],y[i]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; + plot(self); + freqx := nil; + freqy := nil; + x := nil; + y := nil; + ReturnBtn.SetFocus; +end; + +procedure TCorSimFrm.FormShow(Sender: TObject); +begin + Image1.Canvas.Pen.Color := clBlack; + Image1.Canvas.Brush.Color := clWhite; + Image1.Canvas.Rectangle(0, 0, Image1.Width, Image1.Height); + //Image1.Canvas.FloodFill(1,1,clWhite,fsborder); + MeanX.Text := '100'; + MeanY.Text := '100'; + SDX.Text := '15'; + SDY.Text := '15'; + Corr.Text := '.8'; + Nobs.Text := '100'; +end; + +procedure TCorSimFrm.MeanYKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then SDX.SetFocus; +end; + +procedure TCorSimFrm.NobsKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then ComputeBtn.SetFocus; +end; + +procedure TCorSimFrm.SDXKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then SDY.SetFocus; +end; + +procedure TCorSimFrm.SDYKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then Corr.SetFocus; +end; + +procedure TCorSimFrm.plot(Sender: TObject); +var + minx, maxx, miny, maxy, xincrement, yincrement : double; + predy1, predy2, lowerx, upperx, frange, prop : double; + charlabel : string; + xpos, ypos, xpos1, ypos1, xpos2, ypos2 : integer; + i, winwidth, winheight, xoffset, yoffset, xaxislong, yaxislong : integer; + j, xspacing, yspacing, labelwidth, minfreq, maxfreq : integer; + flength, theight, lowery, uppery : integer; +begin + // get min and max of x and y points + minx := x[1]; + maxx := minx; + miny := y[1]; + maxy := miny; + for i := 1 to N do + begin + if (minx > x[i]) then minx := x[i]; + if (maxx < x[i]) then maxx := x[i]; + if (miny > y[i]) then miny := y[i]; + if (maxy < y[i]) then maxy := y[i]; + end; + xincrement := (maxx - minx) / 10; + yincrement := (maxy - miny) / 10; + + winwidth := Image1.Width; + winheight := Image1.Height; + xoffset := winwidth div 5; + yoffset := winheight div 5; + xaxislong := winwidth - xoffset- winwidth div 10; + yaxislong := winheight - yoffset - winheight div 10; + Image1.Canvas.Pen.Color := clBlack; + Image1.Canvas.MoveTo(xoffset,yaxislong); + Image1.Canvas.LineTo(winwidth,yaxislong); + Image1.Canvas.MoveTo(xoffset,yaxislong); + Image1.Canvas.LineTo(xoffset,0); + xspacing := xaxislong div 10; + yspacing := yaxislong div 10; + // do xaxis + for i := 0 to 11 do + begin + Image1.Canvas.MoveTo(xoffset + (i * xspacing),yaxislong); + Image1.Canvas.LineTo(xoffset + (i * xspacing),yaxislong + 10); + charlabel := format('%8.3f',[minx + (i * xincrement)]); + labelwidth := Image1.Canvas.TextWidth(charlabel); + xpos := xoffset + (i * xspacing)-labelwidth div 2; + ypos := yaxislong + 12; + Image1.Canvas.TextOut(xpos,ypos,charlabel); + end; + // do yaxis + for i := 0 to 11 do + begin + Image1.Canvas.MoveTo(xoffset, yaxislong - (i * yspacing)); + Image1.Canvas.LineTo(xoffset-10,yaxislong - (i * yspacing)); + charlabel := format('%8.3f',[miny + (i * yincrement)]); + labelwidth := Image1.Canvas.TextWidth(charlabel); + xpos := xoffset-10-labelwidth; + ypos := yaxislong - (i * yspacing); + Image1.Canvas.TextOut(xpos,ypos,charlabel); + end; + // plot points + Image1.Canvas.Pen.Color := clRed; + for i := 1 to N do + begin + xpos := round(xoffset + ((x[i] - minx) / (maxx - minx) * xaxislong)); + ypos := round(yaxislong - ((y[i] - miny) / (maxy - miny) * yaxislong)); + Image1.Canvas.Ellipse(xpos,ypos,xpos+5,ypos+5); + end; + // draw regression line + Image1.Canvas.Pen.Color := clBlack; + predy1 := newb * minx + newconstant; + predy2 := newb * maxx + newconstant; + xpos1 := xoffset; + xpos2 := xoffset + xaxislong; + ypos1 := round(yaxislong - ((predy1 - miny) / (maxy - miny) * yaxislong)); + ypos2 := round(yaxislong - ((predy2 - miny) / (maxy - miny) * yaxislong)); + Image1.Canvas.MoveTo(xpos1,ypos1); + Image1.Canvas.LineTo(xpos2,ypos2); + + // do x frequency distribution + xincrement := (maxx-minx) / 50.0; + xspacing := xaxislong div 50; + for j := 1 to 51 do freqx[j] := 0; + for i := 1 to N do + begin + for j := 1 to 51 do + begin + lowerx := minx + (j * xincrement); + upperx := minx + ((j+1) * xincrement); + if ((x[i] >= lowerx) and (x[i] < upperx)) then freqx[j] := freqx[j] + 1; + end; + end; + // plot the x frequencies + minfreq := N; + maxfreq := 0; + for j := 1 to 51 do + begin + if (freqx[j] > maxfreq) then maxfreq := freqx[j]; + if (freqx[j] < minfreq) then minfreq := freqx[j]; + end; + flength := winheight - (yaxislong + 25) - Panel1.Height; + for j := 1 to 51 do + begin + xpos := xoffset + (j * xspacing); + ypos1 := round(yaxislong + 25 + + ((freqx[j] - minfreq)/ (maxfreq-minfreq) * (flength))); + ypos2 := yaxislong + 25; + Image1.Canvas.MoveTo(xpos,ypos1); + Image1.Canvas.LineTo(xpos,ypos2); + end; + Image1.Canvas.MoveTo(xoffset,yaxislong+25); + Image1.Canvas.LineTo(winwidth,yaxislong+25); + xpos := 20; + ypos := yaxislong+30; + Image1.Canvas.TextOut(xpos,ypos,'X DISTRIBUTION'); + theight := Image1.Canvas.TextHeight('X'); + ypos := ypos + theight; + charlabel := format('correlation := %6.3f',[newcorr]); + Image1.Canvas.TextOut(xpos,ypos,charlabel); + ypos := ypos + theight; + charlabel := format('Mean X := %8.3f, Mean Y := %8.3f',[newxmean, newymean]); + Image1.Canvas.TextOut(xpos,ypos,charlabel); + charlabel := format('SD X := %8.3f, SD Y := %8.3f',[newxsd, newysd]); + ypos := ypos + theight; + Image1.Canvas.TextOut(xpos,ypos,charlabel); + + // do y frequency distribution + yincrement := (maxy-miny) / 50.0; + yspacing := yaxislong div 50; + for j := 1 to 51 do freqy[j] := 0; + for i := 1 to N do + begin + for j := 1 to 51 do + begin + lowery := round(miny + (j * yincrement)); + uppery := round(miny + ((j+1) * yincrement)); + if ((y[i] >= lowery) and (y[i] < uppery)) then freqy[j] := freqy[j] + 1; + end; + end; + // plot the y frequencies + minfreq := N; + maxfreq := 0; + for j := 1 to 51 do + begin + if (freqy[j] > maxfreq) then maxfreq := freqy[j]; + if (freqy[j] < minfreq) then minfreq := freqy[j]; + end; + flength := winwidth - (xaxislong + 150); + for j := 1 to 51 do + begin + ypos := yaxislong - (j * yspacing); + frange := maxfreq - minfreq; + prop := (freqy[j] - minfreq) / frange; + xpos1 := round(xoffset - 50 - (prop * flength)); + xpos2 := xoffset - 50; + Image1.Canvas.MoveTo(xpos1,ypos); + Image1.Canvas.LineTo(xpos2,ypos); + end; + Image1.Canvas.MoveTo(xoffset - 50,yaxislong); + Image1.Canvas.LineTo(xoffset - 50,0); + Image1.Canvas.TextOut(0,0,'Y DISTRIBUTION'); +end; + +initialization + {$I corsimunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/distribunit.lfm b/applications/lazstats/source/forms/simulations/distribunit.lfm new file mode 100644 index 000000000..d4c24fe8b --- /dev/null +++ b/applications/lazstats/source/forms/simulations/distribunit.lfm @@ -0,0 +1,280 @@ +object DistribFrm: TDistribFrm + Left = 420 + Height = 301 + Top = 215 + Width = 307 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Distributions' + ClientHeight = 301 + ClientWidth = 307 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 12 + Height = 109 + Top = 12 + Width = 180 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 12 + Caption = 'Plot Distribution:' + ChildSizing.LeftRightSpacing = 16 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.VerticalSpacing = 8 + ChildSizing.EnlargeVertical = crsHomogenousSpaceResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 89 + ClientWidth = 176 + TabOrder = 0 + object NDChk: TCheckBox + Left = 16 + Height = 19 + Top = 8 + Width = 144 + Caption = 'Normal Distribution' + OnClick = NDChkClick + TabOrder = 0 + end + object ChiChk: TCheckBox + Left = 16 + Height = 19 + Top = 35 + Width = 144 + Caption = 'Chi-Square Distribution' + OnClick = ChiChkClick + TabOrder = 1 + end + object FChk: TCheckBox + Left = 16 + Height = 19 + Top = 62 + Width = 144 + Caption = 'Central F Distribution' + OnClick = FChkClick + TabOrder = 2 + end + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 12 + Height = 146 + Top = 137 + Width = 180 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 16 + BorderSpacing.Bottom = 12 + Caption = 'Parameters' + ClientHeight = 126 + ClientWidth = 176 + TabOrder = 1 + object AlphaLabel: TLabel + AnchorSideTop.Control = AlphaEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = AlphaEdit + Left = 33 + Height = 15 + Top = 6 + Width = 84 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Type I Error Rate' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = DF1Edit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = DF1Edit + Left = 26 + Height = 15 + Top = 37 + Width = 91 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Deg. Freedom (1)' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = DF2Edit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = DF2Edit + Left = 26 + Height = 15 + Top = 68 + Width = 91 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Deg. Freedom (2)' + ParentColor = False + end + object Label4: TLabel + AnchorSideTop.Control = MeanEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = MeanEdit + Left = 87 + Height = 15 + Top = 99 + Width = 30 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Mean' + ParentColor = False + end + object AlphaEdit: TEdit + AnchorSideTop.Control = GroupBox2 + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 125 + Height = 23 + Top = 2 + Width = 43 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + TabOrder = 0 + Text = 'AlphaEdit' + end + object DF1Edit: TEdit + AnchorSideTop.Control = AlphaEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AlphaEdit + AnchorSideRight.Side = asrBottom + Left = 125 + Height = 23 + Top = 33 + Width = 43 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + TabOrder = 1 + Text = 'Edit1' + end + object MeanEdit: TEdit + AnchorSideTop.Control = DF2Edit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AlphaEdit + AnchorSideRight.Side = asrBottom + Left = 125 + Height = 23 + Top = 95 + Width = 43 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + TabOrder = 3 + Text = 'Edit1' + end + object DF2Edit: TEdit + AnchorSideTop.Control = DF1Edit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = AlphaEdit + AnchorSideRight.Side = asrBottom + Left = 125 + Height = 23 + Top = 64 + Width = 43 + Alignment = taRightJustify + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + TabOrder = 2 + Text = 'Edit1' + end + end + object Panel1: TPanel + AnchorSideLeft.Control = GroupBox1 + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = GroupBox2 + AnchorSideBottom.Side = asrBottom + Left = 208 + Height = 136 + Top = 147 + Width = 76 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Right = 12 + BevelOuter = bvNone + ChildSizing.VerticalSpacing = 12 + ClientHeight = 136 + ClientWidth = 76 + TabOrder = 2 + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 25 + Top = 0 + Width = 76 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 0 + end + object CancelBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ResetBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 25 + Top = 37 + Width = 76 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = CancelBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 25 + Top = 74 + Width = 76 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object ReturnBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ComputeBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 25 + Top = 111 + Width = 76 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + Caption = 'Return' + ModalResult = 1 + TabOrder = 3 + end + end +end diff --git a/applications/lazstats/source/forms/simulations/distribunit.pas b/applications/lazstats/source/forms/simulations/distribunit.pas new file mode 100644 index 000000000..9fa5c8481 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/distribunit.pas @@ -0,0 +1,603 @@ +unit DistribUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Printers, ExtCtrls, Math, + BlankFrmUnit, FunctionsLib, Globals; + + type + TwoCol = array[1..2,1..100] of double; + +type + + { TDistribFrm } + + TDistribFrm = class(TForm) + AlphaEdit: TEdit; + DF1Edit: TEdit; + DF2Edit: TEdit; + MeanEdit: TEdit; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + GroupBox2: TGroupBox; + AlphaLabel: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + NDChk: TCheckBox; + ChiChk: TCheckBox; + FChk: TCheckBox; + GroupBox1: TGroupBox; + procedure ChiChkClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FChkClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure NDChkClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + procedure NDPlot(Sender : TObject); + procedure ChiPlot(Sender : TObject); + procedure FPlot(Sender : TObject); + procedure Hscale(Xmin, Xmax : double; Nsteps : integer; + acolor : TColor; FontSize : integer; + X, Y, Xlength : integer; + charLabel : string; Sender : TObject); + procedure Vscale(Ymin, Ymax : double; Nsteps : integer; + acolor : TColor; FontSize : integer; + X, Y, Ylength : integer; + charLabel : string; Sender : TObject); + procedure NormPts(zMin, zMax : double; Npts : integer; + VAR realpts : TwoCol; + Sender : TObject); + procedure PltPts(realpts : TwoCol; + Xmax, Xmin, Ymax, Ymin : double; + Npts, XaxisStart, YaxisStart, XaxisRange : integer; + YaxisRange : integer; + acolor : TColor; Sender : TObject); + procedure ChiPts(cMin, cMax : double; + Npts, df : integer; + VAR realpts : TwoCol; + Sender : TObject); + procedure FPts(FMin, FMax : double; + Npts, df1, df2 : integer; + VAR realpts : TwoCol; + Sender : TObject); + function chi2func(chisqr, df : double) : double; + function Ffunc(F : double; df1, df2 : integer) : double; + + public + { public declarations } + end; + +var + DistribFrm: TDistribFrm; + +implementation + +{ TDistribFrm } + +procedure TDistribFrm.ResetBtnClick(Sender: TObject); +begin + NDChk.Checked := false; + ChiChk.Checked := false; + FChk.Checked := false; + AlphaEdit.Text := '0.05'; + DF1Edit.Text := ''; + DF2Edit.Text := ''; + MeanEdit.Text := ''; + GroupBox2.Enabled := false; +end; + +procedure TDistribFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TDistribFrm.NDChkClick(Sender: TObject); +begin + if NDChk.Checked then + begin + GroupBox2.Enabled := true; + AlphaLabel.Enabled := true; + AlphaEdit.Enabled := true; + DF1Edit.Enabled := false; + Label2.Enabled := false; + Label3.Enabled := false; + Label4.Enabled := false; + DF2Edit.Enabled := false; + MeanEdit.Enabled := false; + end + else + GroupBox2.Enabled := false; +end; + +procedure TDistribFrm.ComputeBtnClick(Sender: TObject); +begin + if NDChk.Checked then + begin + NDPlot(self); + end; + if ChiChk.Checked then + begin + ChiPlot(self); + end; + if FChk.Checked then + begin + FPlot(self); + end; +end; + +procedure TDistribFrm.FChkClick(Sender: TObject); +begin + if FChk.Checked then + begin + GroupBox2.Enabled := true; + Label3.Enabled := true; + AlphaLabel.Enabled := true; + AlphaEdit.Enabled := true; + DF1Edit.Enabled := true; + DF2Edit.Enabled := true; + Label2.Enabled := true; + Label4.Enabled := false; + MeanEdit.Enabled := false; + end + else + GroupBox2.Enabled := false; +end; + +procedure TDistribFrm.ChiChkClick(Sender: TObject); +begin + if ChiChk.Checked then + begin + GroupBox2.Enabled := true; + Label2.Enabled := true; + DF1Edit.Enabled := true; + Label3.Enabled := false; + Label4.Enabled := false; + AlphaLabel.Enabled := true; + AlphaEdit.Enabled := true; + DF2Edit.Enabled := false; + MeanEdit.Enabled := false; + end else + GroupBox2.Enabled := false; +end; + +procedure TDistribFrm.NDPlot(Sender: TObject); +var + charLabel : string; + Clwidth, Clheight,X, Y, XaxisStart, XaxisEnd, YaxisStart, YaxisEnd : integer; + i, Xrange, Yrange, t : integer; + alpha, h, z, hprop, zprop : double; + realpts : TwoCol; + +begin + for i := 1 to 100 do realpts[1,i] := 0.0; + for i := 1 to 100 do realpts[2,i] := 0.0; + charLabel := 'Normal Distribution. Alpha = '; + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Image1.Canvas.FloodFill(1,1,clWhite,fsborder); + BlankFrm.Image1.Canvas.Pen.Width := 2; + Clwidth := BlankFrm.Image1.Width; + Clheight := BlankFrm.Image1.Height; + XaxisStart := Clwidth div 8; + XaxisEnd := Clwidth - (Clwidth div 8); + YaxisStart := (Clheight * 7) div 10; + YaxisEnd := Clheight div 10; + Xrange := XaxisEnd - XaxisStart; + Yrange := YaxisStart - YaxisEnd; + alpha := StrToFloat(AlphaEdit.Text); + BlankFrm.Show; + + // Create values of normal curve + NormPts(-4.0, 4.0, 100, realpts, self); + PltPts(realpts, 4.0, -4.0, 0.5, 0.0, 100, XaxisStart, YaxisStart, Xrange, + Yrange, clBlack, self); + + // Draw line for alpha z := 1.645 + charLabel := charLabel + AlphaEdit.Text; + BlankFrm.Caption := charLabel; + z := inversez(1.0 - alpha); + zprop := (4.0 + z) / 8.0; + h := (1.0 / sqrt(2.0 * 3.1415)) * (1.0 / exp(z * z / 2.0)); + hprop := (0.5 - h) / 0.5; + X := round( zprop * Xrange)+ XaxisStart; + Y := YaxisEnd + round( hprop * Yrange); + BlankFrm.Image1.Canvas.MoveTo(X,YaxisStart); + BlankFrm.Image1.Canvas.LineTo(X,Y-10); // alpha cutoff + + // floodfill rejection section with red + BlankFrm.Image1.Canvas.Brush.Color := clRed; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + + // create labeled axis + Hscale(-4.0, 4.0, 11, clWhite, 10, XaxisStart, YaxisStart, Xrange,'z SCALE',self); + Vscale(0.0, 0.5, 11, clWhite, 10, XaxisStart, YaxisStart, Yrange, 'DENSITY',self); + + // Print Heading + t := BlankFrm.Image1.Canvas.TextWidth(charLabel); + X := (BlankFrm.Width div 2) - (t div 2); + BlankFrm.Image1.Canvas.TextOut(X,0,charLabel); + charLabel := 'Critical Value = '; + charLabel := charLabel + format('%6.3f',[z]); + t := BlankFrm.Image1.Canvas.TextWidth(charLabel); + X := (BlankFrm.Image1.Width div 2) - (t div 2); + BlankFrm.Image1.Canvas.TextOut(X,BlankFrm.Image1.Canvas.TextHeight(charLabel),charLabel); +end; + +procedure TDistribFrm.ChiPlot(Sender: TObject); +var + charLabel : string; + Clwidth, Clheight, X, Y, XaxisStart, XaxisEnd, YaxisStart, YaxisEnd : integer; + i, Xrange, Yrange, df, t : integer; + alpha, h, z, hprop, zprop, MaxChi, MaxProb : double; + realpts : TwoCol; + +begin + BlankFrm.Image1.Canvas.Clear; + for i := 1 to 100 do realpts[1,i] := 0.0; + for i := 1 to 100 do realpts[2,i] := 0.0; + charLabel := 'Chi Squared Distribution. Alpha = '; + MaxProb := 0.0; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Image1.Canvas.FloodFill(1,1,clWhite,fsborder); + BlankFrm.Image1.Canvas.Pen.Width := 2; + Clwidth := BlankFrm.Image1.Width; + Clheight := BlankFrm.Image1.Height; + XaxisStart := Clwidth div 8; + XaxisEnd := Clwidth - (Clwidth div 8); + YaxisStart := (Clheight * 7) div 10; + YaxisEnd := Clheight div 10; + Xrange := XaxisEnd - XaxisStart; + Yrange := YaxisStart - YaxisEnd; + alpha := StrToFloat(AlphaEdit.Text); + charLabel := charLabel + AlphaEdit.Text; + df := StrToInt(DF1Edit.Text); + if (df < 1) or (df > 100) then exit; + charLabel := charLabel + ' D.F. = '; + charLabel := charLabel + DF1Edit.Text; + BlankFrm.Caption := charLabel; + BlankFrm.Show; + + // Create values of chi-squared curve + MaxChi := 125.0; + ChiPts(0.0, MaxChi, 100, df, realpts, self); + for i := 1 to 100 do + begin + if (realpts[2,i] > MaxProb) then MaxProb := realpts[2,i]; + end; + PltPts(realpts, MaxChi, 0.0, MaxProb, 0.0, 100, XaxisStart, YaxisStart, Xrange, + Yrange, clBlack, self); + + // Draw line for alpha + z := inversechi(1.0-alpha,df); + zprop := z / MaxChi; + h := chi2func(z,df); + hprop := (MaxProb - h) / MaxProb; + X := round( zprop * Xrange)+ XaxisStart; + Y := YaxisEnd + round( hprop * Yrange); + BlankFrm.Image1.Canvas.MoveTo(X,YaxisStart); + BlankFrm.Image1.Canvas.LineTo(X,Y); // alpha cutoff + + // floodfill main section with blue + BlankFrm.Image1.Canvas.Brush.Color := clBlue; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + + // create charLabeled axis + Hscale(0.0, MaxChi, 11, clWhite, 10, XaxisStart, YaxisStart, + Xrange,'CHI SQUARED SCALE',self); + Vscale(0.0, MaxProb, 11, clWhite, 10, XaxisStart, YaxisStart, + Yrange, 'DENSITY',self); + + // Print Heading + t := BlankFrm.Image1.Canvas.TextWidth(charLabel); + X := (BlankFrm.Width div 2) - (t div 2); + BlankFrm.Image1.Canvas.TextOut(X,0,charLabel); + charLabel := 'Critical Value = '; + charLabel := charLabel + format('%6.3f',[z]); + t := BlankFrm.Image1.Canvas.TextWidth(charLabel); + X := (BlankFrm.Image1.Width div 2) - (t div 2); + BlankFrm.Image1.Canvas.TextOut(X,BlankFrm.Image1.Canvas.TextHeight(charLabel),charLabel); +end; + +procedure TDistribFrm.FPlot(Sender: TObject); +var + charLabel : string; + Clwidth, Clheight, X, Y, XaxisStart, XaxisEnd, YaxisStart, YaxisEnd : integer; + i, Xrange, Yrange, t, df1, df2 : integer; + realpts : TwoCol; + alpha, h, F, hprop, Fprop, MaxProb, MaxF : double; + done : boolean; +begin + BlankFrm.Image1.Canvas.Clear; + for i := 1 to 100 do realpts[1,i] := 0.0; + for i := 1 to 100 do realpts[2,i] := 0.0; + MaxProb := 0.0; + charLabel := 'F Distribution. Alpha = '; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Image1.Canvas.FloodFill(1,1,clWhite,fsborder); + BlankFrm.Image1.Canvas.Pen.Width := 2; + Clwidth := BlankFrm.Image1.Width; + Clheight := BlankFrm.Image1.Height; + XaxisStart := Clwidth div 8; + XaxisEnd := Clwidth - (Clwidth div 8); + YaxisStart := (Clheight * 7) div 10; + YaxisEnd := Clheight div 10; + Xrange := XaxisEnd - XaxisStart; + Yrange := YaxisStart - YaxisEnd; + alpha := StrToFloat(AlphaEdit.Text); + charLabel := charLabel + AlphaEdit.Text; + df1 := StrToInt(DF1Edit.Text); + charLabel := charLabel + ' D.F.1 = '; + charLabel := charLabel + DF1Edit.Text; + df2 := StrToInt(DF2Edit.Text); + charLabel := charLabel + ' , D.F.2 = '; + charLabel := charLabel + DF2Edit.Text; + BlankFrm.Caption := charLabel; + BlankFrm.Show; + + // Create values of F curve + MaxF := 20.0; + done := false; + while not done do + begin + h := Ffunc(MaxF, df1, df2); + if (h < 0.001) then MaxF := MaxF - 1.0 + else done := true; + end; + + FPts(0.0, MaxF, 100, df1, df2, realpts, self); + for i := 1 to 100 do + begin + if (realpts[2,i] > MaxProb) then MaxProb := realpts[2,i]; + end; + PltPts(realpts, MaxF, 0.0, MaxProb, 0.0, 100, XaxisStart, YaxisStart, Xrange, + Yrange, clBlack, self); + + // Draw line for alpha + F := fpercentpoint(1.0-alpha,df1,df2); + Fprop := F / MaxF; + h := Ffunc(F,df1,df2); + hprop := (MaxProb - h) / MaxProb; + X := round( Fprop * Xrange)+ XaxisStart; + Y := YaxisEnd + round( hprop * Yrange); + BlankFrm.Image1.Canvas.MoveTo(X,YaxisStart); + BlankFrm.Image1.Canvas.LineTo(X,Y); // alpha cutoff + + // floodfill main section with blue + BlankFrm.Canvas.Brush.Color := clBlue; + + // create charLabeled axis + Hscale(0.0, MaxF, 11, clWhite, 10, XaxisStart, YaxisStart, + Xrange,'F SCALE',self); + Vscale(0.0, MaxProb, 11, clWhite, 10, XaxisStart, YaxisStart, + Yrange, 'DENSITY',self); + + // Print Heading + t := BlankFrm.Image1.Canvas.TextWidth(charLabel); + X := (BlankFrm.Image1.Width div 2) - (t div 2); + BlankFrm.Image1.Canvas.TextOut(X,0,charLabel); + charLabel := 'Critical Value = '; + charLabel := charLabel + format('%6.3f',[F]); + t := BlankFrm.Image1.Canvas.TextWidth(charLabel); + X := (BlankFrm.Image1.Width div 2) - (t div 2); + BlankFrm.Image1.Canvas.TextOut(X,BlankFrm.Image1.Canvas.TextHeight(charLabel),charLabel); +end; + +procedure TDistribFrm.Hscale(Xmin, Xmax: double; Nsteps: integer; + acolor: TColor; FontSize: integer; X, Y, Xlength: integer; charLabel: string; + Sender: TObject); +var + i, TickEnd, Xpos, Ypos, TextX : integer; + Xincr, Xval : double; + Svalue, Ast : string; +begin + BlankFrm.Image1.Canvas.MoveTo(X,Y); + BlankFrm.Image1.Canvas.LineTo(X+Xlength,Y); + BlankFrm.Image1.Canvas.Font.Size := FontSize; + BlankFrm.Image1.Canvas.Brush.Color := acolor; + TickEnd := Y + 10; + Xincr := (Xmax - Xmin) / Nsteps; + for i := 0 to Nsteps do + begin + Xpos := round(((Xlength / Nsteps) * i) + X); + BlankFrm.Image1.Canvas.MoveTo(Xpos,Y); + BlankFrm.Image1.Canvas.LineTo(Xpos,TickEnd); + TextX := Xpos - 8; + Xval := Xmin + ( i * Xincr); + Svalue := format('%4.2f',[Xval]); + Ast := Svalue; + BlankFrm.Image1.Canvas.TextOut(TextX, Y+15, Ast); + end; + // print charLabel below X axis + Ypos := Y + 30; + Xpos := round((BlankFrm.Width / 2) - (BlankFrm.Image1.Canvas.TextWidth(charLabel) / 2)); + BlankFrm.Image1.Canvas.TextOut(Xpos,Ypos,charLabel); +end; + +procedure TDistribFrm.Vscale(Ymin, Ymax: double; Nsteps: integer; + acolor: TColor; FontSize: integer; X, Y, Ylength: integer; charLabel: string; + Sender: TObject); +var + TickEnd, Ypos, Xpos, TextY : integer; + Yincr, Yval : double; + Svalue, symbol, Ast : string; + chpixs, i : integer; +begin + BlankFrm.Image1.Canvas.MoveTo(X,Y); + BlankFrm.Image1.Canvas.LineTo(X,Y-Ylength); + BlankFrm.Image1.Canvas.Font.Size := FontSize; + BlankFrm.Image1.Canvas.Brush.Color := acolor; + TickEnd := X - 10; + Yincr := (Ymax - Ymin) / Nsteps; + TextY := 0; + for i := 0 to Nsteps do + begin + Ypos := round(Y - ((Ylength / Nsteps) * i)); + BlankFrm.Image1.Canvas.MoveTo(X,Ypos); + BlankFrm.Image1.Canvas.LineTo(TickEnd,Ypos); + TextY := TickEnd - 30; + Yval := Ymin + ( i * Yincr); + Svalue := format('%4.2f',[Yval]); + Ast := Svalue; + BlankFrm.Image1.Canvas.TextOut(TextY, Ypos-8, Ast); + end; + // print charLabel vertically + Xpos := TextY - 15; + for i := 1 to Length(charLabel) do + begin + chpixs := BlankFrm.Image1.Canvas.TextHeight(charLabel); + Ypos := round(Y - (Ylength / 2) - ( (Length(charLabel) * chpixs) / 2 ) + (chpixs * i)); + symbol := charLabel[i]; +// symbol[2] := 0; + BlankFrm.Image1.Canvas.TextOut(Xpos,Ypos,symbol); + end; +end; + +procedure TDistribFrm.NormPts(zMin, zMax: double; Npts: integer; + var realpts: TwoCol; Sender: TObject); +var + zIncr, z, h : double; + i : integer; +begin + zIncr := (zMax - zMin) / Npts; + for i := 1 to Npts do + begin + z := zMin + (zIncr * i); + h := (1.0 / sqrt(2.0 * 3.14159265358979)) * + ( 1.0 / exp(z * z / 2.0)); + realpts[1,i] := z; + realpts[2,i] := h; + end; +end; + +procedure TDistribFrm.PltPts(realpts: TwoCol; Xmax, Xmin, Ymax, Ymin: double; + Npts, XaxisStart, YaxisStart, XaxisRange: integer; YaxisRange: integer; + acolor: TColor; Sender: TObject); +var + hprop, zprop, z, h : double; + i, X, Y : integer; + intpts : array[1..100] of TPoint; +begin + for i := 1 to Npts do + begin + z := realpts[1,i]; + h := realpts[2,i]; + zprop := (z - Xmin) / (Xmax - Xmin); + X := round((zprop * XaxisRange) + XaxisStart); + hprop := (h - Ymin) / (Ymax - Ymin); + Y := round(YaxisStart - (hprop * YaxisRange)); + intpts[i] := Point(X,Y); + end; + BlankFrm.Image1.Canvas.Pen.Color := acolor; + BlankFrm.Image1.Canvas.Polyline(Slice(intpts,Npts - 1)); +end; + +procedure TDistribFrm.ChiPts(cMin, cMax: double; Npts, df: integer; + var realpts: TwoCol; Sender: TObject); +var + ratio1, ratio2, ratio3, cIncr, chi, h : double; + i : integer; +begin + ratio1 := df / 2.0; + ratio2 := (df - 2.0) / 2.0; + cIncr := (cMax - cMin) / Npts; + for i := 1 to Npts do + begin + chi := cMin + (cIncr * i); +// h := inversechi(chi, df); + ratio3 := chi / 2.0; + h := (1.0 / (power(2.0,ratio1) * exp(lngamma(ratio1)))) * power(chi,ratio2) * ( 1.0 / exp(ratio3)); + realpts[1,i] := chi; + realpts[2,i] := h; + end; +end; + +procedure TDistribFrm.FPts(FMin, FMax: double; Npts, df1, df2: integer; + var realpts: TwoCol; Sender: TObject); +var + FIncr, F, h : double; + i : integer; +begin + FIncr := (FMax - FMin) / Npts; + for i := 1 to Npts do + begin + F := FMin + (FIncr * i); + h := Ffunc(F, df1, df2); + realpts[1,i] := F; + realpts[2,i] := h; + end; +end; + +function TDistribFrm.chi2func(chisqr, df: double): double; +var + ratio1, ratio2, ratio3, h : double; +begin + // Returns the height of the density curve for the chi-squared statistic + ratio1 := df / 2.0; + ratio2 := (df - 2.0) / 2.0; + ratio3 := chisqr / 2.0; + h := (1.0 / (power(2.0,ratio1) * exp(lngamma(ratio1)))) * power(chisqr,ratio2) * ( 1.0 / exp(ratio3)); + Result := h; +end; + +function TDistribFrm.Ffunc(F: double; df1, df2: integer): double; +var + ratio1, ratio2, ratio3, ratio4, h : double; + part1, part2, part3, part4, part5, part6, part7, part8, part9 : double; +begin + // Returns the height of the density curve for the F statistic + ratio1 := (df1 + df2) / 2.0; + ratio2 := (df1 - 2.0) / 2.0; + ratio3 := df1 / 2.0; + ratio4 := df2 / 2.0; + part1 := exp(lngamma(ratio1)); + part2 := power(df1,ratio3); + part3 := power(df2,ratio4); + part4 := exp(lngamma(ratio3)); + part5 := exp(lngamma(ratio4)); + part6 := power(F,ratio2); + part7 := power((F*df1+df2),ratio1); + part8 := (part1 * part2 * part3) / (part4 * part5); + if (part7 = 0.0) then part9 := 0.0 + else part9 := part6 / part7; + h := part8 * part9; +{ + ratio1 := (df1 + df2) / 2.0; + ratio2 := (df1 - 2.0) / 2.0; + ratio3 := df1 / 2.0; + ratio4 := df2 / 2.0; + ffunc := ((gamma(ratio1) * realraise(df1,ratio3) * + realraise(df2,ratio4)) / + (gamma(ratio3) * gamma(ratio4))) * + (realraise(f,ratio2) / realraise((f*df1+df2),ratio1)); +} + Result := h; +end; + +procedure TDistribFrm.FormCreate(Sender: TObject); +begin + if BlankFrm = nil then + Application.CreateForm(TBlankFrm, BlankFrm); +end; + +initialization + {$I distribunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/errorcurvesunit.lfm b/applications/lazstats/source/forms/simulations/errorcurvesunit.lfm new file mode 100644 index 000000000..1a4abe075 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/errorcurvesunit.lfm @@ -0,0 +1,271 @@ +object ErrorCurvesFrm: TErrorCurvesFrm + Left = 474 + Height = 306 + Top = 160 + Width = 350 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Alpha and Beta Curves for z tests' + ClientHeight = 306 + ClientWidth = 350 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideTop.Control = NullMeanEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NullMeanEdit + Left = 72 + Height = 15 + Top = 92 + Width = 151 + Anchors = [akTop, akRight] + BorderSpacing.Left = 12 + BorderSpacing.Right = 8 + Caption = 'Mean of the Null Hypothesis' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = AltMeanEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = AltMeanEdit + Left = 37 + Height = 15 + Top = 123 + Width = 186 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Mean of the Alternative Hypothesis' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = SDEdit + AnchorSideTop.Side = asrCenter + Left = 24 + Height = 15 + Top = 154 + Width = 199 + Anchors = [akTop] + BorderSpacing.Left = 24 + Caption = 'Standard Deviation of the Distribution' + ParentColor = False + end + object Label4: TLabel + AnchorSideTop.Control = TypeIEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = TypeIEdit + Left = 39 + Height = 15 + Top = 185 + Width = 184 + Anchors = [akTop, akRight] + BorderSpacing.Left = 12 + BorderSpacing.Right = 8 + Caption = 'Probability of Making a Type I Error' + ParentColor = False + end + object Label5: TLabel + AnchorSideTop.Control = TypeIIEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = TypeIIEdit + Left = 36 + Height = 15 + Top = 216 + Width = 187 + Anchors = [akTop, akRight] + BorderSpacing.Left = 12 + BorderSpacing.Right = 8 + Caption = 'Probability of Making a Type II Error' + ParentColor = False + end + object NullMeanEdit: TEdit + AnchorSideLeft.Control = SDEdit + AnchorSideTop.Control = NullType + AnchorSideTop.Side = asrBottom + Left = 231 + Height = 23 + Top = 88 + Width = 60 + Alignment = taRightJustify + BorderSpacing.Top = 8 + BorderSpacing.Right = 24 + TabOrder = 1 + Text = 'NullMeanEdit' + end + object AltMeanEdit: TEdit + AnchorSideLeft.Control = SDEdit + AnchorSideTop.Control = NullMeanEdit + AnchorSideTop.Side = asrBottom + Left = 231 + Height = 23 + Top = 119 + Width = 60 + Alignment = taRightJustify + BorderSpacing.Top = 8 + TabOrder = 2 + Text = 'Edit1' + end + object SDEdit: TEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = AltMeanEdit + AnchorSideTop.Side = asrBottom + Left = 231 + Height = 23 + Top = 150 + Width = 60 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 24 + TabOrder = 3 + Text = 'Edit1' + end + object TypeIEdit: TEdit + AnchorSideLeft.Control = SDEdit + AnchorSideTop.Control = SDEdit + AnchorSideTop.Side = asrBottom + Left = 231 + Height = 23 + Top = 181 + Width = 60 + Alignment = taRightJustify + BorderSpacing.Top = 8 + TabOrder = 4 + Text = 'Edit1' + end + object TypeIIEdit: TEdit + AnchorSideLeft.Control = SDEdit + AnchorSideTop.Control = TypeIEdit + AnchorSideTop.Side = asrBottom + Left = 231 + Height = 23 + Top = 212 + Width = 60 + Alignment = taRightJustify + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + TabOrder = 5 + Text = 'Edit1' + end + object NullType: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + AnchorSideRight.Control = SDEdit + AnchorSideRight.Side = asrBottom + Left = 60 + Height = 72 + Top = 8 + Width = 231 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + Caption = 'Null Hypothesis Characteristic:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 227 + ItemIndex = 1 + Items.Strings = ( + 'One-tailed (Directional alterntive)' + 'Two-tailed (non-directional alterntive)' + ) + TabOrder = 0 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = TypeIIEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 243 + Width = 350 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 277 + Height = 25 + Top = 259 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 6 + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = ResetBtn + Left = 115 + Height = 25 + Top = 259 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 7 + end + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = ComputeBtn + Left = 49 + Height = 25 + Top = 259 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 8 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = ReturnBtn + Left = 189 + Height = 25 + Top = 259 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 9 + end +end diff --git a/applications/lazstats/source/forms/simulations/errorcurvesunit.pas b/applications/lazstats/source/forms/simulations/errorcurvesunit.pas new file mode 100644 index 000000000..84966544b --- /dev/null +++ b/applications/lazstats/source/forms/simulations/errorcurvesunit.pas @@ -0,0 +1,339 @@ +unit ErrorCurvesUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + BlankFrmUnit, FunctionsLib, Globals; + +type + TwoCol = array[1..2,1..100] of double; + +type + + { TErrorCurvesFrm } + + TErrorCurvesFrm = class(TForm) + Bevel1: TBevel; + NullType: TRadioGroup; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + NullMeanEdit: TEdit; + AltMeanEdit: TEdit; + SDEdit: TEdit; + TypeIEdit: TEdit; + TypeIIEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + procedure PltPts(realpts : TwoCol; + Xmax, Xmin, Ymax, Ymin : double; + Npts, XaxisStart, YaxisStart, XaxisRange : integer; + YaxisRange : integer; + acolor : TColor; Sender : TObject); + procedure Hscale(Xmin, Xmax : double; Nsteps : integer; + acolor : TColor; FontSize : integer; + X, Y, Xlength : integer; + charLabel : string; Sender : TObject); + procedure Vscale(Ymin, Ymax : double; Nsteps : integer; + acolor : TColor; FontSize : integer; + X, Y, Ylength : integer; + charLabel : string; Sender : TObject); + procedure NormPts(zMin, zMax : double; Npts : integer; + VAR realpts : TwoCol; + Sender : TObject); + + public + { public declarations } + end; + +var + ErrorCurvesFrm: TErrorCurvesFrm; + +implementation + +{ TErrorCurvesFrm } + +procedure TErrorCurvesFrm.ResetBtnClick(Sender: TObject); +begin + NullMeanEdit.Text := ''; + AltMeanEdit.Text := ''; + SDEdit.Text := ''; + TypeIEdit.Text := '0.05'; + TypeIIEdit.Text := '0.05'; + NullMeanEdit.SetFocus; +end; + +procedure TErrorCurvesFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TErrorCurvesFrm.ComputeBtnClick(Sender: TObject); +var + // generate a null and alternate hypothesis for a specified effect + // size, Type I error rate and Type II error rate using the normal + // distribution z-test. Estimate the N needed. + // Uses the Plot.h header file and form FrmPlot. + Clwidth,Clheight,X,Y,XaxisStart,XaxisEnd,YaxisStart,YaxisEnd : integer; + Xrange, Yrange, t, range, Nsize: integer; + alpha, beta, nullmean, altmean, Diff, StdDev, CriticalX, zalpha : double; + zbeta, Xprop, stderrmean, xlow, xhigh : double; + valuestr, charLabel : string; + realpts : TwoCol; +begin + BlankFrm.Show; + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + BlankFrm.Image1.Canvas.Clear; + BlankFrm.Image1.Canvas.FloodFill(1,1,clWhite,fsborder); + alpha := StrToFloat(TypeIEdit.Text); + if NullType.ItemIndex = 1 then alpha := alpha / 2.0; + beta := StrToFloat(TypeIIEdit.Text); + nullmean := StrToFloat(NullMeanEdit.Text); + altmean := StrToFloat(AltMeanEdit.Text); + StdDev := StrToFloat(SDEdit.Text); + zalpha := inversez(1.0 - alpha); + zbeta := inversez(1.0 - beta); + Diff := abs(nullmean - altmean); + Nsize := round((StdDev / Diff) * abs(zbeta + zalpha)); + Nsize := Nsize * Nsize; + CriticalX := zalpha * (StdDev / sqrt(Nsize)) + nullmean; + stderrmean := StdDev / sqrt(Nsize); + Clwidth := BlankFrm.Image1.Width; + Clheight := BlankFrm.Image1.Height; + + // Determine X scale and print it + YaxisStart := (Clheight * 6) div 10; + YaxisEnd := Clheight div 10; + Yrange := YaxisStart - YaxisEnd; + xlow := nullmean - 4 * stderrmean; + xhigh := altmean + 4 * stderrmean; + XaxisStart := Clwidth div 8; + XaxisEnd := Clwidth - (Clwidth div 8); + Xrange := XaxisEnd - XaxisStart; + Hscale(xlow, xhigh, 9, clWhite, 8, XaxisStart, YaxisStart, Xrange,'X SCALE',BlankFrm); + + // Create values of the alternative distribution + Xprop := ( (nullmean + 4*stderrmean) - xlow) / (xhigh - xlow); + range := round(Xprop * Xrange); + NormPts(-4.0, 4.0, 100, realpts, self); + Xprop := ((altmean - 4 * stderrmean) - xlow) / (xhigh - xlow); + X := round((Xprop * Xrange) + XaxisStart); // where to start curve + PltPts(realpts, 4.0, -4.0, 0.5, 0.0, 100, X, YaxisStart, range, + Yrange, clBlack, self); + + //Draw vertical axis at the critical X value + Xprop := (CriticalX - xlow) / (xhigh - xlow); + X := round((Xprop * Xrange) + XaxisStart); + Y := YaxisStart; + BlankFrm.Image1.Canvas.MoveTo(X,Y); + BlankFrm.Image1.Canvas.LineTo(X,YaxisEnd); + charLabel := 'Critical X = '; + valuestr := format('%6.2f',[CriticalX]); + charLabel := charLabel + valuestr; + t := BlankFrm.Image1.Canvas.TextWidth(charLabel) div 2; + BlankFrm.Image1.Canvas.TextOut(X-t,YaxisEnd-15,charLabel); + + // floodfill Alternate distribution area with blue + Xprop := (CriticalX - xlow) / (xhigh - xlow); + X := round((Xprop * Xrange) + XaxisStart); + Y := YaxisStart - 3; + BlankFrm.Image1.Canvas.Brush.Color := clBlue; + BlankFrm.Image1.Canvas.FloodFill(X-2,Y,clBlack,fsBorder ); + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + + // Create values of normal curve for null distribution + NormPts(-4.0, 4.0, 100, realpts, self); + Xprop := ( (nullmean + 4*stderrmean) - xlow) / (xhigh - xlow); + range := round(Xprop * Xrange); + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + PltPts(realpts, 4.0, -4.0, 0.5, 0.0, 100, XaxisStart, YaxisStart, range, + Yrange, clBlack, self); + + //Draw vertical axis at null mean + Xprop := (nullmean - xlow) / (xhigh - xlow); + X := round((Xprop * Xrange) + XaxisStart); + Y := YaxisStart; + BlankFrm.Image1.Canvas.MoveTo(X,Y); + BlankFrm.Image1.Canvas.LineTo(X,YaxisEnd); + charLabel := 'Null Mean'; + t := BlankFrm.Image1.Canvas.TextWidth(charLabel) div 2; + BlankFrm.Image1.Canvas.TextOut(X-t,YaxisEnd,charLabel); + + // floodfill alpha area with red + Xprop := (CriticalX - xlow) / (xhigh - xlow); + X := round((Xprop * Xrange) + XaxisStart); + Y := YaxisStart - 3; + BlankFrm.Image1.Canvas.Brush.Color := clRed; + BlankFrm.Image1.Canvas.FloodFill(X+2,Y,clBlack,fsBorder ); + BlankFrm.Image1.Canvas.Brush.Color := clWhite; + + //Draw vertical axis at alternative mean + BlankFrm.Image1.Canvas.Pen.Color := clBlack; + Xprop := (altmean - xlow) / (xhigh - xlow); + X := round((Xprop * Xrange) + XaxisStart); + Y := YaxisStart; + BlankFrm.Image1.Canvas.MoveTo(X,Y); + BlankFrm.Image1.Canvas.LineTo(X,YaxisEnd); + charLabel := 'Alternative Mean'; + t := BlankFrm.Image1.Canvas.TextWidth(charLabel) div 2; + BlankFrm.Image1.Canvas.TextOut(X-t,YaxisEnd,charLabel); + + // draw the vertical density axis scale values + Vscale(0.0, 0.5, 11, clWhite, 10, XaxisStart, YaxisStart, Yrange, 'DENSITY', self); + + // Print Heading + charLabel := 'Type I and II Error Areas'; + BlankFrm.Caption := charLabel; + charLabel := 'Alpha := '; + charLabel := charLabel + TypeIEdit.Text; + charLabel := charLabel + ', Beta := '; + charLabel := charLabel + TypeIIEdit.Text; + charLabel := charLabel + ', N := '; + charLabel := charLabel + IntToStr(Nsize); + t := BlankFrm.Image1.Canvas.TextWidth(charLabel); + X := round((BlankFrm.Image1.Width / 2) - (t / 2)); + BlankFrm.Image1.Canvas.TextOut(X,0,charLabel); + + // print z scale for the null distribution + Xprop := ( (nullmean + 4*stderrmean) - xlow) / (xhigh - xlow); + range := round(Xprop * Xrange); + Hscale(-4.0, 4.0, 11, clWhite, 8, XaxisStart, YaxisStart+50, range,'NULL Z SCALE', self); + + end; + +procedure TErrorCurvesFrm.FormCreate(Sender: TObject); +begin + if BlankFrm = nil then + Application.CreateForm(TBlankFrm, BlankFrm); +end; + +procedure TErrorCurvesFrm.PltPts(realpts: TwoCol; Xmax, Xmin, Ymax, + Ymin: double; Npts, XaxisStart, YaxisStart, XaxisRange: integer; + YaxisRange: integer; acolor: TColor; Sender: TObject); +var + hprop, zprop, z, h : double; + i, X, Y : integer; + intpts : array[1..100] of TPoint; +begin + for i := 1 to Npts do + begin + z := realpts[1,i]; + h := realpts[2,i]; + zprop := (z - Xmin) / (Xmax - Xmin); + X := round((zprop * XaxisRange) + XaxisStart); + hprop := (h - Ymin) / (Ymax - Ymin); + Y := round(YaxisStart - (hprop * YaxisRange)); + intpts[i] := Point(X,Y); + end; + BlankFrm.Image1.Canvas.Pen.Color := acolor; + BlankFrm.Image1.Canvas.Polyline(Slice(intpts,Npts - 1)); +end; + +procedure TErrorCurvesFrm.Hscale(Xmin, Xmax: double; Nsteps: integer; + acolor: TColor; FontSize: integer; X, Y, Xlength: integer; charLabel: string; + Sender: TObject); +var + i, TickEnd, Xpos, Ypos, TextX : integer; + Xincr, Xval : double; + Svalue, Ast : string; +begin + BlankFrm.Image1.Canvas.MoveTo(X,Y); + BlankFrm.Image1.Canvas.LineTo(X+Xlength,Y); + BlankFrm.Image1.Canvas.Font.Size := FontSize; + BlankFrm.Image1.Canvas.Brush.Color := acolor; + TickEnd := Y + 10; + Xincr := (Xmax - Xmin) / Nsteps; + for i := 0 to Nsteps + 1 do + begin + Xpos := round(((Xlength / Nsteps) * i) + X); + BlankFrm.Image1.Canvas.MoveTo(Xpos,Y); + BlankFrm.Image1.Canvas.LineTo(Xpos,TickEnd); + TextX := Xpos - 8; + Xval := Xmin + ( i * Xincr); + Svalue := format('%4.2f',[Xval]); + Ast := Svalue; + BlankFrm.Image1.Canvas.TextOut(TextX, Y+15, Ast); + end; + // print label below X axis + Ypos := Y + 30; + Xpos := round((BlankFrm.Image1.Width / 2) - (BlankFrm.Image1.Canvas.TextWidth(charLabel) / 2)); + BlankFrm.Image1.Canvas.TextOut(Xpos,Ypos,charLabel); +end; + +procedure TErrorCurvesFrm.Vscale(Ymin, Ymax: double; Nsteps: integer; + acolor: TColor; FontSize: integer; X, Y, Ylength: integer; charLabel: string; + Sender: TObject); +var + TickEnd, Ypos, Xpos, TextY : integer; + Yincr, Yval : double; + Svalue, symbol, Ast : string; + chpixs, i : integer; +begin + BlankFrm.Image1.Canvas.MoveTo(X,Y); + BlankFrm.Image1.Canvas.LineTo(X,Y-Ylength); + BlankFrm.Image1.Canvas.Font.Size := FontSize; + BlankFrm.Image1.Canvas.Brush.Color := acolor; + TickEnd := X - 10; + Yincr := (Ymax - Ymin) / Nsteps; + TextY := 0; + for i := 0 to Nsteps + 1 do + begin + Ypos := round(Y - ((Ylength / Nsteps) * i)); + BlankFrm.Image1.Canvas.MoveTo(X,Ypos); + BlankFrm.Image1.Canvas.LineTo(TickEnd,Ypos); + TextY := TickEnd - 30; + Yval := Ymin + ( i * Yincr); + Svalue := format('%4.2f',[Yval]); + Ast := Svalue; + BlankFrm.Image1.Canvas.TextOut(TextY, Ypos-8, Ast); + end; + // print label vertically + Xpos := TextY - 15; + for i := 1 to Length(charLabel) do + begin + chpixs := BlankFrm.Image1.Canvas.TextHeight(charLabel); + Ypos := round(Y - (Ylength / 2) - ( (Length(charLabel) * chpixs) / 2 ) + (chpixs * i)); + symbol := charLabel[i]; +// symbol[2] := 0; + BlankFrm.Image1.Canvas.TextOut(Xpos,Ypos,symbol); + end; +end; + +procedure TErrorCurvesFrm.NormPts(zMin, zMax: double; Npts: integer; + var realpts: TwoCol; Sender: TObject); +var + zIncr, z, h : double; + i : integer; +begin + zIncr := (zMax - zMin) / Npts; + for i := 1 to Npts do + begin + z := zMin + (zIncr * i); + h := (1.0 / sqrt(2.0 * 3.14159265358979)) * + ( 1.0 / exp(z * z / 2.0)); + realpts[1,i] := z; + realpts[2,i] := h; + end; +end; + +initialization + {$I errorcurvesunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/fprobunit.lfm b/applications/lazstats/source/forms/simulations/fprobunit.lfm new file mode 100644 index 000000000..f5b132269 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/fprobunit.lfm @@ -0,0 +1,224 @@ +object FForm: TFForm + Left = 288 + Height = 143 + Top = 161 + Width = 455 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Probability of a larger F value' + ClientHeight = 143 + ClientWidth = 455 + OnActivate = FormActivate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ResetBtn + Left = 142 + Height = 25 + Top = 109 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 24 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 0 + end + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + Left = 216 + Height = 25 + Top = 109 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 282 + Height = 25 + Top = 109 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 370 + Height = 25 + Top = 109 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 24 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 3 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 93 + Width = 455 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 12 + Height = 85 + Top = 8 + Width = 412 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BevelOuter = bvNone + ClientHeight = 85 + ClientWidth = 412 + TabOrder = 4 + object Label1: TLabel + AnchorSideTop.Control = FEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label4 + AnchorSideRight.Side = asrBottom + Left = 88 + Height = 15 + Top = 4 + Width = 117 + Anchors = [akTop, akRight] + Caption = 'Given: An F statistic = ' + ParentColor = False + end + object FEdit: TEdit + AnchorSideLeft.Control = ProbEdit + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ProbEdit + AnchorSideRight.Side = asrBottom + Left = 213 + Height = 23 + Top = 0 + Width = 80 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + Text = 'FEdit' + end + object Label2: TLabel + AnchorSideTop.Control = DF1Edit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label4 + AnchorSideRight.Side = asrBottom + Left = 88 + Height = 15 + Top = 31 + Width = 117 + Anchors = [akTop, akRight] + Caption = 'with Deg. Freedom of ' + ParentColor = False + end + object DF1Edit: TEdit + AnchorSideLeft.Control = ProbEdit + AnchorSideTop.Control = FEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ProbEdit + AnchorSideRight.Side = asrBottom + Left = 213 + Height = 23 + Top = 27 + Width = 80 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 1 + Text = 'DF1Edit' + end + object Label3: TLabel + AnchorSideLeft.Control = DF1Edit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = DF1Edit + AnchorSideTop.Side = asrCenter + Left = 301 + Height = 15 + Top = 31 + Width = 23 + BorderSpacing.Left = 8 + Caption = 'and ' + ParentColor = False + end + object DF2Edit: TEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = DF1Edit + Left = 332 + Height = 23 + Top = 27 + Width = 80 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 2 + Text = 'DF2Edit' + end + object Label4: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ProbEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 66 + Width = 205 + Caption = 'then the probability of a larger value = ' + ParentColor = False + end + object ProbEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = DF1Edit + AnchorSideTop.Side = asrBottom + Left = 213 + Height = 23 + Top = 62 + Width = 80 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 3 + Text = 'ProbEdit' + end + end +end diff --git a/applications/lazstats/source/forms/simulations/fprobunit.pas b/applications/lazstats/source/forms/simulations/fprobunit.pas new file mode 100644 index 000000000..ec1724318 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/fprobunit.pas @@ -0,0 +1,87 @@ +unit FProbUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + Functionslib; + +type + + { TFForm } + + TFForm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + ComputeBtn: TButton; + DF1Edit: TEdit; + DF2Edit: TEdit; + Panel1: TPanel; + ProbEdit: TEdit; + FEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + ResetBtn: TButton; + ReturnBtn: TButton; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + FForm: TFForm; + +implementation + +uses + Math; + +{ TFForm } + +procedure TFForm.ResetBtnClick(Sender: TObject); +begin + FEdit.Text := ''; + DF1Edit.Text := ''; + DF2Edit.Text := ''; + ProbEdit.Text := ''; +end; + +procedure TFForm.ComputeBtnClick(Sender: TObject); +VAR + F, df1, df2, prob : extended; + outvalue : string; +begin + F := StrToFloat(FEdit.Text); + df1 := StrToFloat(DF1Edit.Text); + df2 := StrToFloat(DF2Edit.Text); + prob := probf(F,df1,df2); + outvalue := format('%6.4f',[prob]); + ProbEdit.Text := outvalue; +end; + +procedure TFForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([CancelBtn.Width, ResetBtn.Width, ReturnBtn.Width, ComputeBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + + +initialization + {$I fprobunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/genrndvalsunit.lfm b/applications/lazstats/source/forms/simulations/genrndvalsunit.lfm new file mode 100644 index 000000000..0ce09bce3 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/genrndvalsunit.lfm @@ -0,0 +1,524 @@ +object GenRndValsFrm: TGenRndValsFrm + Left = 707 + Height = 349 + Top = 203 + Width = 429 + AutoSize = True + BorderStyle = bsSingle + Caption = 'Generate Random Values' + ClientHeight = 349 + ClientWidth = 429 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = LabelEdit + AnchorSideTop.Side = asrCenter + Left = 16 + Height = 15 + Top = 102 + Width = 78 + BorderSpacing.Left = 16 + Caption = 'Variable Label: ' + ParentColor = False + end + object RadioGroup1: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 12 + Height = 74 + Top = 12 + Width = 405 + Anchors = [akTop, akLeft, akRight] + AutoFill = False + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 12 + BorderSpacing.Right = 12 + Caption = 'Generate Cases For:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 6 + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 2 + ClientHeight = 54 + ClientWidth = 401 + Items.Strings = ( + 'All Current Cases' + 'A Specific Number of Cases' + ) + OnClick = RadioGroup1Click + TabOrder = 0 + object Label11: TLabel + Left = 184 + Height = 19 + Top = 6 + Width = 80 + Caption = ' ' + ParentColor = False + end + object NoCasesEdit: TEdit + Left = 184 + Height = 23 + Top = 25 + Width = 80 + Alignment = taRightJustify + OnExit = NoCasesEditExit + TabOrder = 2 + Text = 'NoCasesEdit' + end + end + object LabelEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = RadioGroup1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 102 + Height = 23 + Top = 98 + Width = 315 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + BorderSpacing.Right = 12 + TabOrder = 1 + Text = 'LabelEdit' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = LabelEdit + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 165 + Top = 133 + Width = 404 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 12 + BorderSpacing.Right = 12 + Caption = 'Distribution shape' + ClientHeight = 145 + ClientWidth = 400 + TabOrder = 2 + object Label2: TLabel + AnchorSideLeft.Control = rbFDistributionValues + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = rbFlatInteger + AnchorSideTop.Side = asrCenter + Left = 168 + Height = 15 + Top = 6 + Width = 48 + BorderSpacing.Left = 24 + Caption = 'Between ' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Label10 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Label2 + Left = 297 + Height = 15 + Top = 6 + Width = 23 + BorderSpacing.Left = 16 + BorderSpacing.Right = 16 + Caption = 'and ' + ParentColor = False + end + object LowIntEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrCenter + Left = 228 + Height = 23 + Top = 2 + Width = 52 + Alignment = taRightJustify + BorderSpacing.Left = 12 + OnKeyPress = LowIntEditKeyPress + TabOrder = 1 + Text = 'LowIntEdit' + end + object HiIntEdit: TEdit + AnchorSideLeft.Control = FDF2Edit + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = FDF2Edit + AnchorSideRight.Side = asrBottom + Left = 336 + Height = 23 + Top = 2 + Width = 52 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + TabOrder = 2 + Text = 'HiIntEdit' + end + object rbFlatInteger: TRadioButton + Tag = 1 + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + Left = 16 + Height = 19 + Top = 4 + Width = 87 + BorderSpacing.Left = 16 + BorderSpacing.Top = 4 + Caption = 'Flat - Integer' + OnChange = DistTypeChange + TabOrder = 0 + end + object Label4: TLabel + AnchorSideLeft.Control = Label2 + AnchorSideTop.Control = rbFlatFloatingPoint + AnchorSideTop.Side = asrCenter + Left = 168 + Height = 15 + Top = 33 + Width = 48 + Caption = 'Between ' + ParentColor = False + end + object Label5: TLabel + AnchorSideLeft.Control = Label10 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = LowRealEdit + AnchorSideTop.Side = asrCenter + Left = 298 + Height = 15 + Top = 33 + Width = 20 + Caption = 'and' + ParentColor = False + end + object LowRealEdit: TEdit + AnchorSideLeft.Control = LowIntEdit + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LowIntEdit + AnchorSideRight.Side = asrBottom + Left = 228 + Height = 23 + Top = 29 + Width = 52 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + OnKeyPress = LowRealEditKeyPress + TabOrder = 4 + Text = 'LowRealEdit' + end + object HiRealEdit: TEdit + AnchorSideLeft.Control = FDF2Edit + AnchorSideTop.Control = Label5 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = FDF2Edit + AnchorSideRight.Side = asrBottom + Left = 336 + Height = 23 + Top = 29 + Width = 52 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + TabOrder = 5 + Text = 'HiRealEdit' + end + object rbFlatFloatingPoint: TRadioButton + Tag = 2 + AnchorSideLeft.Control = rbFlatInteger + AnchorSideTop.Control = rbFlatInteger + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 19 + Top = 31 + Width = 124 + BorderSpacing.Top = 8 + Caption = 'Flat - Floating Point' + OnChange = DistTypeChange + TabOrder = 3 + end + object rbNormalZValues: TRadioButton + Tag = 3 + AnchorSideLeft.Control = rbFlatFloatingPoint + AnchorSideTop.Control = rbFlatFloatingPoint + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 19 + Top = 58 + Width = 105 + BorderSpacing.Top = 8 + Caption = 'Normal z Values' + OnChange = DistTypeChange + TabOrder = 6 + end + object Label6: TLabel + AnchorSideLeft.Control = Label4 + AnchorSideTop.Control = rbNormalZValues + AnchorSideTop.Side = asrCenter + Left = 168 + Height = 15 + Top = 60 + Width = 44 + Caption = 'Mean = ' + ParentColor = False + end + object Label7: TLabel + AnchorSideLeft.Control = Label10 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = rbNormalZValues + AnchorSideTop.Side = asrCenter + Left = 291 + Height = 15 + Top = 60 + Width = 34 + BorderSpacing.Left = 7 + Caption = 'S.D. = ' + ParentColor = False + end + object zMeanEdit: TEdit + AnchorSideLeft.Control = LowRealEdit + AnchorSideTop.Control = rbNormalZValues + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LowRealEdit + AnchorSideRight.Side = asrBottom + Left = 228 + Height = 23 + Top = 56 + Width = 52 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + OnKeyPress = zMeanEditKeyPress + TabOrder = 7 + Text = 'zMeanEdit' + end + object zSDEdit: TEdit + AnchorSideLeft.Control = FDF2Edit + AnchorSideTop.Control = rbNormalZValues + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = FDF2Edit + AnchorSideRight.Side = asrBottom + Left = 336 + Height = 23 + Top = 56 + Width = 52 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + TabOrder = 8 + Text = 'zSDEdit' + end + object rbChiSquaredValues: TRadioButton + Tag = 4 + AnchorSideLeft.Control = rbNormalZValues + AnchorSideTop.Control = rbNormalZValues + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 19 + Top = 85 + Width = 123 + BorderSpacing.Top = 8 + Caption = 'Chi-Squared Values' + OnChange = DistTypeChange + TabOrder = 9 + end + object Label8: TLabel + AnchorSideLeft.Control = Label4 + AnchorSideTop.Control = rbChiSquaredValues + AnchorSideTop.Side = asrCenter + Left = 168 + Height = 15 + Top = 87 + Width = 40 + Caption = 'D.F. 1 =' + ParentColor = False + end + object ChiDFEdit: TEdit + AnchorSideLeft.Control = zMeanEdit + AnchorSideTop.Control = rbChiSquaredValues + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = zMeanEdit + AnchorSideRight.Side = asrBottom + Left = 228 + Height = 23 + Top = 83 + Width = 52 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + TabOrder = 10 + Text = 'ChiDFEdit' + end + object rbFDistributionValues: TRadioButton + Tag = 5 + AnchorSideLeft.Control = rbChiSquaredValues + AnchorSideTop.Control = rbChiSquaredValues + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 19 + Top = 112 + Width = 128 + BorderSpacing.Top = 8 + Caption = 'F Distribution Values' + OnChange = DistTypeChange + TabOrder = 11 + end + object Label9: TLabel + AnchorSideLeft.Control = Label8 + AnchorSideTop.Control = rbFDistributionValues + AnchorSideTop.Side = asrCenter + Left = 168 + Height = 15 + Top = 114 + Width = 40 + Caption = 'D.F. 1 =' + ParentColor = False + end + object Label10: TLabel + AnchorSideLeft.Control = FDF1Edit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = rbFDistributionValues + AnchorSideTop.Side = asrCenter + Left = 288 + Height = 15 + Top = 114 + Width = 40 + BorderSpacing.Left = 8 + Caption = 'D.F. 2 =' + ParentColor = False + end + object FDF1Edit: TEdit + AnchorSideLeft.Control = ChiDFEdit + AnchorSideTop.Control = rbFDistributionValues + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ChiDFEdit + AnchorSideRight.Side = asrBottom + Left = 228 + Height = 23 + Top = 110 + Width = 52 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + OnKeyPress = FDF1EditKeyPress + TabOrder = 12 + Text = 'FDF1Edit' + end + object FDF2Edit: TEdit + AnchorSideLeft.Control = Label10 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = rbFDistributionValues + AnchorSideTop.Side = asrCenter + AnchorSideRight.Side = asrBottom + Left = 336 + Height = 23 + Top = 110 + Width = 52 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 12 + TabOrder = 13 + Text = 'FDF2Edit' + end + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 26 + Top = 318 + Width = 413 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 26 + ClientWidth = 413 + TabOrder = 3 + object ResetBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = CancelBtn + Left = 136 + Height = 25 + Top = 1 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 0 + end + object CancelBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ComputeBtn + Left = 198 + Height = 25 + Top = 1 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ReturnBtn + Left = 268 + Height = 25 + Top = 1 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 352 + Height = 25 + Top = 1 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Return' + ModalResult = 1 + TabOrder = 3 + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 302 + Width = 429 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/simulations/genrndvalsunit.pas b/applications/lazstats/source/forms/simulations/genrndvalsunit.pas new file mode 100644 index 000000000..493e81fd4 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/genrndvalsunit.pas @@ -0,0 +1,314 @@ +unit GenRndValsUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, + StdCtrls, Globals, MainUnit, DictionaryUnit; + +type + + { TGenRndValsFrm } + + TGenRndValsFrm = class(TForm) + Bevel1: TBevel; + GroupBox1: TGroupBox; + NoCasesEdit: TEdit; + Label11: TLabel; + Panel1: TPanel; + rbFDistributionValues: TRadioButton; + rbChiSquaredValues: TRadioButton; + rbNormalZValues: TRadioButton; + rbFlatInteger: TRadioButton; + rbFlatFloatingPoint: TRadioButton; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + ChiDFEdit: TEdit; + FDF2Edit: TEdit; + FDF1Edit: TEdit; + Label10: TLabel; + Label8: TLabel; + Label9: TLabel; + zSDEdit: TEdit; + zMeanEdit: TEdit; + HiRealEdit: TEdit; + Label5: TLabel; + Label6: TLabel; + Label7: TLabel; + LowRealEdit: TEdit; + Label4: TLabel; + LowIntEdit: TEdit; + HiIntEdit: TEdit; + Label2: TLabel; + Label3: TLabel; + LabelEdit: TEdit; + Label1: TLabel; + RadioGroup1: TRadioGroup; + procedure ComputeBtnClick(Sender: TObject); + procedure FDF1EditKeyPress(Sender: TObject; var Key: char); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure LowIntEditKeyPress(Sender: TObject; var Key: char); + procedure LowRealEditKeyPress(Sender: TObject; var Key: char); + procedure NoCasesEditExit(Sender: TObject); + procedure RadioGroup1Click(Sender: TObject); + procedure DistTypeChange(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure zMeanEditKeyPress(Sender: TObject; var Key: char); + private + { private declarations } + Ncases : integer; + DistType : integer; + public + { public declarations } + end; + +var + GenRndValsFrm: TGenRndValsFrm; + +implementation + +uses + Math; + +{ TGenRndValsFrm } + +procedure TGenRndValsFrm.RadioGroup1Click(Sender: TObject); +begin + if RadioGroup1.ItemIndex = 1 then + begin + if NoCases <= 0 then + begin + ShowMessage('Error! There are currently no cases!'); + exit; + end + else Ncases := NoCases + end + else NoCasesEdit.SetFocus; +end; + +procedure TGenRndValsFrm.LowIntEditKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then HiIntEdit.SetFocus; +end; + +procedure TGenRndValsFrm.FDF1EditKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then FDF2Edit.SetFocus; +end; + +procedure TGenRndValsFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TGenRndValsFrm.ComputeBtnClick(Sender: TObject); +var + i, j : integer; + col : integer; + RndNo : integer; + RealRnd : double; + Range : integer; + MinReal, MaxReal : double; + Mean, StdDev : double; + SumX1, SumX2 : double; + df1, df2 : integer; +begin + if LabelEdit.Text = '' then + begin + ShowMessage('Error. Enter a label for the variable.'); + exit; + end; + if DistType <= 0 then + begin + ShowMessage('First, select a distribution type.'); + exit; + end; + if RadioGroup1.ItemIndex < 0 then + begin + ShowMessage('Select an option for the number of values to generate.'); + exit; + end; + if (RadioGroup1.ItemIndex = 1) and (NoCasesEdit.Text = '') then + begin + ShowMessage('Error! Number of cases not specified.'); + exit; + end + else Ncases := StrToInt(NoCasesEdit.Text); + if NoCases < Ncases then + begin + OS3MainFrm.DataGrid.RowCount := NCases + 1; + OS3MainFrm.NoCasesEdit.Text := IntToStr(NCases); + NoCases := Ncases; + end; + DictionaryFrm.DictGrid.ColCount := 8; + if NoVariables <= 0 then // a new data file + begin + OS3MainFrm.DataGrid.ColCount := 2; + for i := 1 to Ncases do + OS3MainFrm.DataGrid.Cells[0,i] := format('Case %d',[i]); + col := 1; + DictionaryFrm.DictGrid.RowCount := 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := LabelEdit.Text; + OS3MainFrm.DataGrid.Cells[col,0] := LabelEdit.Text; + end + else // existing data file + begin + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := LabelEdit.Text; + OS3MainFrm.DataGrid.Cells[col,0] := LabelEdit.Text; + end; + randomize; + case DistType of + 1 : begin // range of integers + Range := StrToInt(HiIntEdit.Text) - StrToInt(LowIntEdit.Text); + for i := 1 to Ncases do + begin + RndNo := random(Range); + RndNo := RndNo + StrToInt(LowIntEdit.Text); + OS3MainFrm.DataGrid.Cells[col,i] := IntToStr(RndNo); + end; + end; + 2 : begin // range of real random numbers + MinReal := StrToFloat(LowRealEdit.Text); + MaxReal := StrToFloat(HiRealEdit.Text); + Range := round(MaxReal - MinReal); + for i := 1 to Ncases do + begin + RealRnd := random; + RndNo := random(Range); + RealRnd := RndNo + RealRnd + MinReal; + OS3MainFrm.DataGrid.Cells[col,i] := format('%8.3f',[RealRnd]); + end; + end; + 3 : begin // normally distributed z score + Mean := StrToFloat(zMeanEdit.Text); + StdDev := StrToFloat(zSDEdit.Text); + for i := 1 to Ncases do + begin + RealRnd := RandG(Mean,StdDev); + OS3MainFrm.DataGrid.Cells[col,i] := format('%8.3f',[RealRnd]); + end; + end; + 4 : begin // Chi square is a sum of df squared normally distributed z scores + df1 := StrToInt(ChiDFEdit.Text); + for i := 1 to Ncases do + begin + SumX1 := 0.0; + for j := 1 to df1 do + begin + RealRnd := RandG(0.0,1.0); + SumX1 := SumX1 + (RealRnd * RealRnd); + end; + OS3MainFrm.DataGrid.Cells[col,i] := format('%8.3f',[SumX1]); + end; + end; + 5 : begin // F ratio is a ratio of two independent chi-squares + df1 := StrToInt(FDF1Edit.Text); + df2 := StrToInt(FDF2Edit.Text); + for i := 1 to Ncases do + begin + SumX1 := 0.0; + SumX2 := 0.0; + for j := 1 to df1 do + begin + RealRnd := RandG(0.0,1.0); + SumX1 := SumX1 + (RealRnd * RealRnd); + end; + for j := 1 to df2 do + begin + RealRnd := RandG(0.0,1.0); + SumX2 := SumX2 + (RealRnd * RealRnd); + end; + RealRnd := SumX1 / SumX2; + OS3MainFrm.DataGrid.Cells[col,i] := format('%8.3f',[RealRnd]); + end; + end; + end; + NoVariables := col; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases); +end; + +procedure TGenRndValsFrm.FormShow(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + ResetBtnClick(self); +end; + +procedure TGenRndValsFrm.LowRealEditKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then HiRealEdit.SetFocus; +end; + +procedure TGenRndValsFrm.NoCasesEditExit(Sender: TObject); +begin + if RadioGroup1.ItemIndex = 1 then Ncases := StrToInt(NoCasesEdit.Text); +end; + +procedure TGenRndValsFrm.DistTypeChange(Sender: TObject); +begin + DistType := (Sender as TRadioButton).Tag; + case DistType of + 1 : LowIntEdit.SetFocus; + 2 : LowRealEdit.SetFocus; + 3 : zMeanEdit.SetFocus; + 4 : ChiDFEdit.SetFocus; + 5 : FDF1Edit.SetFocus; + else + begin + ShowMessage('Please select a distribution type before pressing Compute.'); + exit; + end; + end; +end; + +procedure TGenRndValsFrm.ResetBtnClick(Sender: TObject); +begin + NoCasesEdit.Text := ''; + RadioGroup1.ItemIndex := -1; + rbFlatInteger.Checked := false; + rbFlatFloatingPoint.Checked := false; + rbNormalZValues.Checked := false; + rbChiSquaredValues.Checked := false; + rbFDistributionValues.Checked := false; +// RadioGroup2.ItemIndex := -1; + LabelEdit.Text := ''; + LowIntEdit.Text := ''; + HiIntEdit.Text := ''; + LowRealEdit.Text := ''; + HiRealEdit.Text := ''; + zMeanEdit.Text := ''; + zSDEdit.Text := ''; + ChiDFEdit.Text := ''; + FDF1Edit.Text := ''; + FDF2Edit.Text := ''; + DistType := 0; +end; + +procedure TGenRndValsFrm.zMeanEditKeyPress(Sender: TObject; var Key: char); +begin + if Ord(Key) = 13 then zSDEdit.SetFocus; +end; + +initialization + {$I genrndvalsunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/gensequnit.lfm b/applications/lazstats/source/forms/simulations/gensequnit.lfm new file mode 100644 index 000000000..557e2344e --- /dev/null +++ b/applications/lazstats/source/forms/simulations/gensequnit.lfm @@ -0,0 +1,226 @@ +object GenSeqFrm: TGenSeqFrm + Left = 390 + Height = 192 + Top = 114 + Width = 367 + AutoSize = True + Caption = 'Generation of Sequential Values' + ClientHeight = 192 + ClientWidth = 367 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Label2 + AnchorSideRight.Side = asrBottom + Left = 47 + Height = 15 + Top = 96 + Width = 99 + Anchors = [akTop, akRight] + BorderSpacing.Left = 12 + Caption = 'Start Sequence At: ' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = IncrEdit + Left = 34 + Height = 15 + Top = 127 + Width = 112 + Anchors = [akTop, akRight] + BorderSpacing.Left = 12 + BorderSpacing.Right = 8 + Caption = 'Increment Values By: ' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Label2 + AnchorSideRight.Side = asrBottom + Left = 41 + Height = 15 + Top = 160 + Width = 105 + Anchors = [akTop, akRight] + BorderSpacing.Left = 12 + Caption = 'New Variable Label: ' + ParentColor = False + end + object RadioGroup1: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 74 + Top = 8 + Width = 236 + AutoFill = False + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Generate for:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 2 + ClientHeight = 54 + ClientWidth = 232 + Items.Strings = ( + 'All Current Cases' + 'Number of Cases = ' + ) + OnClick = RadioGroup1Click + TabOrder = 0 + object StaticText1: TStaticText + Left = 140 + Height = 19 + Top = 6 + Width = 80 + Caption = ' ' + TabOrder = 2 + end + object NoCasesEdit: TEdit + Left = 140 + Height = 23 + Top = 25 + Width = 80 + Alignment = taRightJustify + BorderSpacing.Left = 3 + OnExit = NoCasesEditExit + TabOrder = 3 + Text = 'NoCasesEdit' + end + end + object StartAtEdit: TEdit + AnchorSideLeft.Control = LabelEdit + AnchorSideTop.Control = RadioGroup1 + AnchorSideTop.Side = asrBottom + Left = 154 + Height = 23 + Top = 90 + Width = 78 + Alignment = taRightJustify + BorderSpacing.Top = 8 + TabOrder = 1 + Text = 'StartAtEdit' + end + object IncrEdit: TEdit + AnchorSideLeft.Control = LabelEdit + AnchorSideTop.Control = StartAtEdit + AnchorSideTop.Side = asrBottom + Left = 154 + Height = 23 + Top = 121 + Width = 78 + Alignment = taRightJustify + BorderSpacing.Top = 8 + TabOrder = 2 + Text = 'IncrEdit' + end + object LabelEdit: TEdit + AnchorSideTop.Control = IncrEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = RadioGroup1 + AnchorSideRight.Side = asrBottom + Left = 154 + Height = 23 + Top = 152 + Width = 78 + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + TabOrder = 3 + Text = 'LabelEdit' + end + object Panel1: TPanel + AnchorSideLeft.Control = RadioGroup1 + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = LabelEdit + AnchorSideBottom.Side = asrBottom + Left = 260 + Height = 136 + Top = 39 + Width = 76 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ChildSizing.VerticalSpacing = 12 + ClientHeight = 136 + ClientWidth = 76 + TabOrder = 4 + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 25 + Top = 0 + Width = 76 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 0 + end + object CancelBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ResetBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 25 + Top = 37 + Width = 76 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = CancelBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 25 + Top = 74 + Width = 76 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object ReturnBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ComputeBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 25 + Top = 111 + Width = 76 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 3 + end + end +end diff --git a/applications/lazstats/source/forms/simulations/gensequnit.pas b/applications/lazstats/source/forms/simulations/gensequnit.pas new file mode 100644 index 000000000..d9ce6af6a --- /dev/null +++ b/applications/lazstats/source/forms/simulations/gensequnit.pas @@ -0,0 +1,160 @@ +unit GenSeqUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, Globals, + MainUnit, DictionaryUnit; + + +type + + { TGenSeqFrm } + + TGenSeqFrm = class(TForm) + NoCasesEdit: TEdit; + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + LabelEdit: TEdit; + Label3: TLabel; + StartAtEdit: TEdit; + IncrEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + RadioGroup1: TRadioGroup; + StaticText1: TStaticText; + procedure ComputeBtnClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure NoCasesEditExit(Sender: TObject); + procedure RadioGroup1Click(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + Ncases : integer; + public + { public declarations } + end; + +var + GenSeqFrm: TGenSeqFrm; + +implementation + +{ TGenSeqFrm } + +procedure TGenSeqFrm.ResetBtnClick(Sender: TObject); +begin + RadioGroup1.ItemIndex := 1; + NoCasesEdit.Text := ''; + StartAtEdit.Text := ''; + IncrEdit.Text := ''; + LabelEdit.Text := ''; +end; + +procedure TGenSeqFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TGenSeqFrm.ComputeBtnClick(Sender: TObject); +var + i, col : integer; + First, Increment : double; +begin + if StartAtEdit.Text = '' then + begin + ShowMessage('Error! No starting value provided.'); + exit; + end; + if IncrEdit.Text = '' then + begin + ShowMessage('Error! No increment value provided.'); + exit; + end; + if LabelEdit.Text = '' then + begin + ShowMessage('Error! No variable label provided.'); + exit; + end; + if NoCases < Ncases then + begin + OS3MainFrm.DataGrid.RowCount := NCases + 1; + OS3MainFrm.NoCasesEdit.Text := IntToStr(NCases); + NoCases := Ncases; + end; + if NoVariables <= 0 then // a new data file + begin + OS3MainFrm.DataGrid.ColCount := 2; + OS3MainFrm.DataGrid.RowCount := Ncases + 1; + for i := 1 to Ncases do + OS3MainFrm.DataGrid.Cells[0,i] := format('Case %d',[i]); + col := 1; + DictionaryFrm.DictGrid.RowCount := 1; + DictionaryFrm.DictGrid.ColCount := 8; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := LabelEdit.Text; + OS3MainFrm.DataGrid.Cells[1,0] := LabelEdit.Text; + DictionaryFrm.DictGrid.RowCount := 2; + NoVariables := 1; + + end + else // existing data file + begin + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := LabelEdit.Text; + end; + + First := StrToFloat(StartAtEdit.Text); + Increment := StrToFloat(IncrEdit.Text); + for i := 1 to Ncases do + begin + OS3MainFrm.DataGrid.Cells[col,i] := format('%8.3f',[First]); + First := First + Increment; + end; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); +end; + +procedure TGenSeqFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TGenSeqFrm.NoCasesEditExit(Sender: TObject); +begin + if RadioGroup1.ItemIndex = 1 then Ncases := StrToInt(NoCasesEdit.Text); + if (Ncases <= 0) and (RadioGroup1.ItemIndex = 1) then + begin + ShowMessage('Error! No. of cases to generate not specified.'); + exit; + end; +end; + +procedure TGenSeqFrm.RadioGroup1Click(Sender: TObject); +begin + if RadioGroup1.ItemIndex = 0 then + begin + if NoCases <= 0 then + begin + ShowMessage('Error! There are currently no cases!'); + exit; + end + else Ncases := NoCases; + end + else NoCasesEdit.SetFocus; +end; + +initialization + {$I gensequnit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/hypergeounit.lfm b/applications/lazstats/source/forms/simulations/hypergeounit.lfm new file mode 100644 index 000000000..87442ca3c --- /dev/null +++ b/applications/lazstats/source/forms/simulations/hypergeounit.lfm @@ -0,0 +1,355 @@ +object HyperGeoForm: THyperGeoForm + AnchorSideRight.Control = Label8 + AnchorSideRight.Side = asrBottom + Left = 303 + Height = 310 + Top = 156 + Width = 339 + Anchors = [akTop] + AutoSize = True + BorderStyle = bsSingle + Caption = 'Hypergeometric Probabilities' + ClientHeight = 310 + ClientWidth = 339 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideTop.Control = SampSizeEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label8 + AnchorSideRight.Side = asrBottom + Left = 134 + Height = 15 + Top = 12 + Width = 68 + Anchors = [akTop, akRight] + Caption = 'Sample Size: ' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = SampObsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label8 + AnchorSideRight.Side = asrBottom + Left = 50 + Height = 15 + Top = 39 + Width = 152 + Anchors = [akTop, akRight] + Caption = 'Number observed in sample:' + ParentColor = False + end + object Label3: TLabel + AnchorSideTop.Control = PopObsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label8 + AnchorSideRight.Side = asrBottom + Left = 118 + Height = 15 + Top = 93 + Width = 84 + Anchors = [akTop, akRight] + Caption = 'Population Size:' + ParentColor = False + end + object Label4: TLabel + AnchorSideTop.Control = PopSizeEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label8 + AnchorSideRight.Side = asrBottom + Left = 30 + Height = 15 + Top = 66 + Width = 172 + Anchors = [akTop, akRight] + Caption = 'Number observed in population:' + ParentColor = False + end + object Label5: TLabel + AnchorSideTop.Control = ProbXEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label8 + AnchorSideRight.Side = asrBottom + Left = 118 + Height = 15 + Top = 132 + Width = 84 + Anchors = [akTop, akRight] + Caption = 'Probability of X:' + ParentColor = False + end + object Label6: TLabel + AnchorSideTop.Control = ProbGTEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label8 + AnchorSideRight.Side = asrBottom + Left = 65 + Height = 15 + Top = 159 + Width = 137 + Anchors = [akTop, akRight] + Caption = 'Probability greater than X:' + ParentColor = False + end + object Label7: TLabel + AnchorSideTop.Control = ProbLEEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label8 + AnchorSideRight.Side = asrBottom + Left = 50 + Height = 15 + Top = 186 + Width = 152 + Anchors = [akTop, akRight] + Caption = 'Probability less or equal to X:' + ParentColor = False + end + object Label8: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ProbGEEdit + AnchorSideTop.Side = asrCenter + Left = 32 + Height = 15 + Top = 213 + Width = 170 + BorderSpacing.Left = 32 + Caption = 'Probability greater or equal to X:' + ParentColor = False + end + object Label9: TLabel + AnchorSideTop.Control = ProbLTEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label8 + AnchorSideRight.Side = asrBottom + Left = 83 + Height = 15 + Top = 240 + Width = 119 + Anchors = [akTop, akRight] + Caption = 'Probability less than X:' + ParentColor = False + end + object ResetBtn: TButton + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ComputeBtn + Left = 65 + Height = 25 + Top = 276 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 0 + end + object ComputeBtn: TButton + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ReturnBtn + Left = 131 + Height = 25 + Top = 276 + Width = 76 + AutoSize = True + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 1 + end + object ReturnBtn: TButton + AnchorSideLeft.Control = ComputeBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + Left = 219 + Height = 25 + Top = 276 + Width = 61 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 2 + end + object SampSizeEdit: TEdit + AnchorSideLeft.Control = ProbGEEdit + AnchorSideTop.Control = Owner + AnchorSideRight.Control = ProbGEEdit + AnchorSideRight.Side = asrBottom + Left = 210 + Height = 23 + Top = 8 + Width = 82 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 3 + Text = 'SampSizeEdit' + end + object SampObsEdit: TEdit + AnchorSideLeft.Control = SampSizeEdit + AnchorSideTop.Control = SampSizeEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ProbGEEdit + AnchorSideRight.Side = asrBottom + Left = 210 + Height = 23 + Top = 35 + Width = 82 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 4 + Text = 'Edit1' + end + object PopSizeEdit: TEdit + AnchorSideLeft.Control = SampSizeEdit + AnchorSideTop.Control = SampObsEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ProbGEEdit + AnchorSideRight.Side = asrBottom + Left = 210 + Height = 23 + Top = 62 + Width = 82 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 5 + Text = 'Edit1' + end + object PopObsEdit: TEdit + AnchorSideLeft.Control = SampSizeEdit + AnchorSideTop.Control = PopSizeEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ProbGEEdit + AnchorSideRight.Side = asrBottom + Left = 210 + Height = 23 + Top = 89 + Width = 82 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 6 + Text = 'Edit1' + end + object ProbXEdit: TEdit + AnchorSideLeft.Control = SampSizeEdit + AnchorSideTop.Control = PopObsEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ProbLEEdit + AnchorSideRight.Side = asrBottom + Left = 210 + Height = 23 + Top = 128 + Width = 82 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 16 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 7 + Text = 'Edit1' + end + object ProbGTEdit: TEdit + AnchorSideLeft.Control = SampSizeEdit + AnchorSideTop.Control = ProbXEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ProbGEEdit + AnchorSideRight.Side = asrBottom + Left = 210 + Height = 23 + Top = 155 + Width = 82 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 8 + Text = 'Edit1' + end + object ProbLEEdit: TEdit + AnchorSideLeft.Control = ProbGEEdit + AnchorSideTop.Control = ProbGTEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ProbGEEdit + AnchorSideRight.Side = asrBottom + Left = 210 + Height = 23 + Top = 182 + Width = 82 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 9 + Text = 'Edit1' + end + object ProbGEEdit: TEdit + AnchorSideLeft.Control = Label8 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ProbLEEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = SampSizeEdit + AnchorSideRight.Side = asrBottom + Left = 210 + Height = 23 + Top = 209 + Width = 82 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 4 + BorderSpacing.Right = 32 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 10 + Text = 'Edit1' + end + object ProbLTEdit: TEdit + AnchorSideLeft.Control = ProbGEEdit + AnchorSideTop.Control = ProbGEEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ProbGEEdit + AnchorSideRight.Side = asrBottom + Left = 210 + Height = 23 + Top = 236 + Width = 82 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 11 + Text = 'Edit1' + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ProbLTEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 9 + Top = 259 + Width = 339 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/simulations/hypergeounit.pas b/applications/lazstats/source/forms/simulations/hypergeounit.pas new file mode 100644 index 000000000..03db324d4 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/hypergeounit.pas @@ -0,0 +1,202 @@ +unit HyperGeoUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + FunctionsLib, OutputUnit; + +type + + { THyperGeoForm } + + THyperGeoForm = class(TForm) + Bevel1: TBevel; + ResetBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + SampSizeEdit: TEdit; + SampObsEdit: TEdit; + PopSizeEdit: TEdit; + PopObsEdit: TEdit; + ProbXEdit: TEdit; + ProbGTEdit: TEdit; + ProbLEEdit: TEdit; + ProbGEEdit: TEdit; + ProbLTEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Label7: TLabel; + Label8: TLabel; + Label9: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure FisherTable(A,B,C,D, p, SumP : double); + private + { private declarations } + + public + { public declarations } + end; + +var + HyperGeoForm: THyperGeoForm; + +implementation + +uses + Math; + +{ THyperGeoForm } + +procedure THyperGeoForm.ResetBtnClick(Sender: TObject); +begin + SampSizeEdit.Text := ''; + SampObsEdit.Text := ''; + PopSizeEdit.Text := ''; + PopObsEdit.Text := ''; + ProbXEdit.Text := ''; + ProbGEEdit.Text := ''; + ProbLTEdit.Text := ''; + ProbLEEdit.Text := ''; + ProbGTEdit.Text := ''; + label5.Enabled := false; + label6.Enabled := false; + label7.Enabled := false; + label8.Enabled := false; + label9.Enabled := false; + ProbXEdit.Enabled := false; + ProbGEEdit.Enabled := false; + ProbLTEdit.Enabled := false; + ProbLEEdit.Enabled := false; + ProbGTEdit.Enabled := false; +end; + +procedure THyperGeoForm.ComputeBtnClick(Sender: TObject); +VAR + SampObs, PopObs, SampSize, PopSize, N : double; + A, B, C, D, APlusC, BPlusD, APlusB, CPlusD : double; + ProbX, Prob, SumProb, ProbGE, ProbGT, ProbLT, ProbLE : double; + done : boolean; + outvalue : string; +begin + done := false; + SumProb := 0.0; + label5.Enabled := true; + label6.Enabled := true; + label7.Enabled := true; + label8.Enabled := true; + label9.Enabled := true; + ProbXEdit.Enabled := true; + ProbGEEdit.Enabled := true; + ProbLTEdit.Enabled := true; + ProbLEEdit.Enabled := true; + ProbGTEdit.Enabled := true; + SampObs := StrToFloat(SampObsEdit.Text); + PopObs := StrToFloat(PopObsEdit.Text); + SampSize := StrToFloat(SampSizeEdit.Text); + PopSize := StrToFloat(PopSizeEdit.Text); + A := SampObs; + B := SampSize - A; + C := PopObs; + D := PopSize - C; + APlusC := A + C; + BPlusD := B + D; + APlusB := A + B; + CPlusD := C + D; + N := A + B + C + D; + +// largest := 1; + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Hypergeometric Distribution Calculations'); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Accumulating Values of the distribution'); + OutputFrm.RichEdit.Lines.Add(''); + ProbX := combos(A,C) * combos(B,D) / combos(APlusB,CPlusD); + outvalue := format('%6.4f',[ProbX]); + ProbXEdit.Text := outvalue; + SumProb := SumProb + ProbX; + FisherTable(A,B,C,D,ProbX,SumProb); + + // get more extreme probabilities + while not done do + begin + if A = APlusB then done := true + else begin + A := A + 1; + B := B - 1; + if (A < 0) or (B < 0) or (C < 0) or (D < 0) then done := true; + end; + if not done then + begin + Prob := combos(A,C) * combos(B,D) / combos(APlusB,CPlusD); + SumProb := SumProb + Prob; + FisherTable(A,B,C,D,Prob,SumProb); + end; + end; // end while not done + OutputFrm.ShowModal; + ProbGE := SumProb; + ProbGT := SumProb - ProbX; + ProbLT := 1.0 - ProbGE; + ProbLE := ProbLT + ProbX; + outvalue := format('%6.4f',[ProbGE]); + ProbGEEdit.Text := outvalue; + outvalue := format('%6.4f',[ProbLE]); + ProbLEEdit.Text := outvalue; + outvalue := format('%6.4f',[ProbGT]); + ProbGTEdit.Text := outvalue; + outvalue := format('%6.4f',[ProbLT]); + ProbLTEdit.Text := outvalue; + OutputFrm.RichEdit.Clear; +end; + +procedure THyperGeoForm.FisherTable(A,B,C,D, p, SumP : double); +VAR + outline : string; +begin + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Table for Hypergeometric Probabilities'); + OutputFrm.RichEdit.Lines.Add(' Column'); + OutputFrm.RichEdit.Lines.Add('Row 1 2'); + outline := format(' 1 %10.0f %10.0f',[A,B]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format(' 2 %10.0f %10.0f',[C,D]); + OutputFrm.RichEdit.Lines.Add(outline); + outline := format('Probability = %6.4f',[p]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := format('Cumulative Probability = %6.4f',[SumP]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); +end; + +procedure THyperGeoForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +procedure THyperGeoForm.FormCreate(Sender: TObject); +begin + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); +end; + +initialization + {$I hypergeounit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/inversezunit.lfm b/applications/lazstats/source/forms/simulations/inversezunit.lfm new file mode 100644 index 000000000..94829005a --- /dev/null +++ b/applications/lazstats/source/forms/simulations/inversezunit.lfm @@ -0,0 +1,169 @@ +object InversezForm: TInversezForm + Left = 590 + Height = 128 + Top = 313 + Width = 346 + AutoSize = True + BorderStyle = bsSingle + Caption = 'Normal z for a given probability' + ClientHeight = 128 + ClientWidth = 346 + OnActivate = FormActivate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ResetBtn + Left = 41 + Height = 25 + Top = 78 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 0 + end + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + Left = 115 + Height = 25 + Top = 78 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 181 + Height = 25 + Top = 78 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 269 + Height = 25 + Top = 78 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 + Caption = 'Return' + ModalResult = 1 + TabOrder = 3 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 62 + Width = 346 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 54 + Height = 54 + Top = 8 + Width = 239 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 54 + ClientWidth = 239 + TabOrder = 4 + object Label1: TLabel + AnchorSideTop.Control = ProbEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label2 + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 15 + Top = 4 + Width = 135 + Anchors = [akTop, akRight] + Caption = 'Cumulative Probability = ' + ParentColor = False + end + object ProbEdit: TEdit + AnchorSideLeft.Control = ZEdit + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ZEdit + AnchorSideRight.Side = asrBottom + Left = 151 + Height = 23 + Top = 0 + Width = 88 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + Text = 'ProbEdit' + end + object Label2: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ZEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 35 + Width = 143 + Caption = 'Corresponds to a z value = ' + ParentColor = False + end + object ZEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ProbEdit + AnchorSideTop.Side = asrBottom + Left = 151 + Height = 23 + Top = 31 + Width = 88 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 1 + Text = 'ZEdit' + end + end +end diff --git a/applications/lazstats/source/forms/simulations/inversezunit.pas b/applications/lazstats/source/forms/simulations/inversezunit.pas new file mode 100644 index 000000000..78fbc11b9 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/inversezunit.pas @@ -0,0 +1,78 @@ +unit InverseZUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + Functionslib; + +type + + { TInversezForm } + + TInversezForm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + ComputeBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + ReturnBtn: TButton; + ZEdit: TEdit; + Label2: TLabel; + ProbEdit: TEdit; + Label1: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + InversezForm: TInversezForm; + +implementation + +uses + Math; + +{ TInversezForm } + +procedure TInversezForm.ResetBtnClick(Sender: TObject); +begin + ProbEdit.Text := ''; + ZEdit.Text := ''; +end; + +procedure TInversezForm.ComputeBtnClick(Sender: TObject); +VAR + Prob, Zscore : double; + outvalue : string; +begin + Prob := StrToFloat(ProbEdit.Text); + Zscore := inversez(Prob); + outvalue := format('%6.4f',[Zscore]); + ZEdit.Text := outvalue; +end; + +procedure TInversezForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([CancelBtn.Width, ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +initialization + {$I inversezunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/multgenunit.lfm b/applications/lazstats/source/forms/simulations/multgenunit.lfm new file mode 100644 index 000000000..905246919 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/multgenunit.lfm @@ -0,0 +1,228 @@ +object MultGenFrm: TMultGenFrm + Left = 517 + Height = 396 + Top = 254 + Width = 581 + ActiveControl = NoVarsEdit + Caption = 'Multivariate Generator' + ClientHeight = 396 + ClientWidth = 581 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object NoVarsEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + Left = 126 + Height = 23 + Top = 8 + Width = 45 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + OnExit = NoVarsEditExit + OnKeyPress = NoVarsEditKeyPress + TabOrder = 0 + Text = 'NoVarsEdit' + end + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = NoVarsEdit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 12 + Width = 110 + BorderSpacing.Left = 8 + Caption = 'Number of variables:' + ParentColor = False + end + object Label2: TLabel + AnchorSideTop.Control = NoObsEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NoObsEdit + Left = 53 + Height = 15 + Top = 39 + Width = 65 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'Sample Size:' + ParentColor = False + end + object NoObsEdit: TEdit + AnchorSideLeft.Control = NoVarsEdit + AnchorSideTop.Control = NoVarsEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NoVarsEdit + AnchorSideRight.Side = asrBottom + Left = 126 + Height = 23 + Top = 35 + Width = 45 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + OnExit = NoObsEditExit + OnKeyPress = NoObsEditKeyPress + TabOrder = 1 + Text = 'NoObsEdit' + end + object ParmsChk: TCheckBox + AnchorSideLeft.Control = NoVarsEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NoVarsEdit + AnchorSideTop.Side = asrCenter + Left = 203 + Height = 19 + Top = 10 + Width = 106 + BorderSpacing.Left = 32 + Caption = 'Print Parametes:' + TabOrder = 2 + end + object SampleChk: TCheckBox + AnchorSideLeft.Control = ParmsChk + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ParmsChk + AnchorSideTop.Side = asrCenter + Left = 333 + Height = 19 + Top = 10 + Width = 118 + BorderSpacing.Left = 24 + BorderSpacing.Right = 8 + Caption = 'Print Sample Stats:' + TabOrder = 3 + end + object PerturbChk: TCheckBox + AnchorSideLeft.Control = ParmsChk + AnchorSideTop.Control = NoObsEdit + AnchorSideTop.Side = asrCenter + Left = 203 + Height = 19 + Top = 37 + Width = 247 + BorderSpacing.Right = 8 + Caption = 'Select Distribution Perturbation Parameters' + TabOrder = 4 + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 284 + Height = 25 + Top = 363 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 7 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 350 + Height = 25 + Top = 363 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 8 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 424 + Height = 25 + Top = 363 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 9 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 512 + Height = 25 + Top = 363 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 10 + end + object Grid: TStringGrid + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = NoObsEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 281 + Top = 66 + Width = 565 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goTabs, goSmoothScroll] + TabOrder = 5 + OnKeyPress = GridKeyPress + OnSetEditText = GridSetEditText + end + object HelpBtn: TButton + Tag = 133 + AnchorSideRight.Control = ResetBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 221 + Height = 25 + Top = 363 + Width = 51 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 6 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 347 + Width = 581 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/simulations/multgenunit.pas b/applications/lazstats/source/forms/simulations/multgenunit.pas new file mode 100644 index 000000000..426a903d2 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/multgenunit.pas @@ -0,0 +1,465 @@ +unit MultGenUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Grids, ExtCtrls, Math, + Globals, MainUnit, OutputUnit, DictionaryUnit, MatrixLib, ContextHelpUnit; + +type + + { TMultGenFrm } + + TMultGenFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + PerturbChk: TCheckBox; + SampleChk: TCheckBox; + ParmsChk: TCheckBox; + NoObsEdit: TEdit; + Label2: TLabel; + NoVarsEdit: TEdit; + Label1: TLabel; + Grid: TStringGrid; + procedure CancelBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure GridKeyPress(Sender: TObject; var Key: char); + procedure GridSetEditText(Sender: TObject; ACol, ARow: Integer; + const Value: string); + procedure HelpBtnClick(Sender: TObject); + procedure NoObsEditExit(Sender: TObject); + procedure NoObsEditKeyPress(Sender: TObject; var Key: char); + procedure NoVarsEditExit(Sender: TObject); + procedure NoVarsEditKeyPress(Sender: TObject; var Key: char); + procedure ResetBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + private + { private declarations } + NoVars : integer; + NoObs : integer; + gridrow, gridcol : integer; + + public + { public declarations } + end; + +var + MultGenFrm: TMultGenFrm; + +implementation + +{ TMultGenFrm } + +procedure TMultGenFrm.ResetBtnClick(Sender: TObject); +VAR i, j : integer; +begin + NoVarsEdit.Text := ''; + NoObsEdit.Text := ''; + ParmsChk.Checked := true; + SampleChk.Checked := true; + Grid.RowCount := 2; + Grid.ColCount := 2; + for i := 0 to 1 do + for j := 0 to 1 do Grid.Cells[i,j] := ''; + //CancelBtn.SetFocus; // <-- is this needed? +end; + +procedure TMultGenFrm.ReturnBtnClick(Sender: TObject); +begin + exit; +end; + +procedure TMultGenFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TMultGenFrm.ComputeBtnClick(Sender: TObject); +var + RhoMat : DblDyneMat; + SampMat : DblDyneMat; + Mus : DblDyneVec; + means : DblDyneVec; + Sigmas : DblDyneVec; + stddevs : DblDyneVec; + i, j, k, i1, i2, n2, k1 : integer; + determ, n3, r1, s8, s9, d2, x, y, mean : double; + linestring : string; + cellstring : string; + singular : boolean; + title : string; + RowLabels: StrDyneVec; + ColLabels: StrDyneVec; +begin + OutputFrm.RichEdit.Clear; + + // get memory allocations + SetLength(RhoMat,NoVars,NoVars); + SetLength(SampMat,NoVars,NoVars); + SetLength(Mus,NoVars); + SetLength(means,NoVars); + SetLength(Sigmas,NoVars); + SetLength(stddevs,NoVars); + SetLength(RowLabels,NoVars); + SetLength(ColLabels,NoVars); + + // get data from grid into arrays + for i := 1 to NoVars do + for j := 1 to NoVars do + begin + RhoMat[i-1,j-1] := StrToFloat(Grid.Cells[i,j]); + end; + for i := 1 to NoVars do + begin + Mus[i-1] := StrToFloat(Grid.Cells[i,NoVars+1]); + Sigmas[i-1] := StrToFloat(Grid.Cells[i,NoVars+2]); + RowLabels[i-1] := Grid.Cells[i,0]; + ColLabels[i-1] := RowLabels[i-1]; + end; + + // get determinant of Rho matrix, i.e. check for singularity + singular := FALSE; + for i := 0 to NoVars-1 do + begin + for j := 0 to NoVars - 1 do + begin + SampMat[i,j] := RhoMat[i,j] * Sigmas[i] * Sigmas[j]; + RhoMat[i,j] := SampMat[i,j]; + end; + end; + + n2 := 1; + i1 := 0; + while (n2 < NoVars) do + begin + for i := n2 to NoVars - 1 do + begin + n3 := RhoMat[i,i1] / RhoMat[i1,i1]; + for j := n2 to NoVars - 1 do RhoMat[i,j] := RhoMat[i,j] - (RhoMat[i1,j] * n3); + end; + i1 := n2; + n2 := N2 + 1; + end; + determ := 1.0; + for i := 0 to NoVars - 1 do determ := determ * RhoMat[i,i]; + linestring := format('Determinant of the population matrix = %10.4f',[determ]); + OutputFrm.RichEdit.Lines.Add(linestring); + + // triangular factorization + if (abs(determ) > 0.00001) then + begin + if (SampMat[0,0] < 0.0) then SampMat[0,0] := 1.0; + r1 := sqrt(SampMat[0,0]); + for i := 0 to NoVars - 1 do + begin + RhoMat[i,0] := SampMat[i,0] / r1; + for j := 1 to NoVars - 1 do RhoMat[i,j] := 0.0; + end; + for i := 1 to NoVars - 1 do + begin + s9 := 0.0; + k1 := i - 1; + for k := 0 to k1 - 1 do s9 := s9 + (RhoMat[i,k] * RhoMat[i,k]); + d2 := SampMat[i,i] - s9; + if (d2 > 0.0) then + begin + RhoMat[i,i] := sqrt(d2); + for j := 1 to i - 1 do + begin + if (j <> i) then + begin + s8 := 0.0; + k1 := j - 1; + for k := 0 to k1 - 1 do s8 := s8 + (RhoMat[i,k] * RhoMat[j,k]); + RhoMat[i,j] := (SampMat[i,j] - s8) / RhoMat[j,j]; + end; + end; // end j loop + end; // end if d2 > 0 + end; // end i loop +// title := 'Triangularized Matrix'; +// MAT_PRINT(RhoMat,NoVars,NoVars,title,RowLabels,ColLabels,NoObs); + + // initialize variables for mainform grid + NoVariables := 0; + DictionaryFrm.DictGrid.RowCount := 1; + DictionaryFrm.DictGrid.ColCount := 8; + if not PerturbChk.Checked then + begin + for i := 1 to NoVars do + begin + DictionaryFrm.NewVar(i); +// NoVariables := NoVariables + 1; + end; + NoCases := NoObs; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVars); + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoObs); + end else + begin + for i := 1 to NoVars*2 do + begin + DictionaryFrm.NewVar(i); +// NoVariables := NoVariables + 1; + end; + NoCases := NoObs; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVars*2); + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoObs); + end; + + // Now generate score vectors + for i2 := 0 to NoObs - 1 do // rows + begin // label case heading + cellstring := format('Case%d',[i2+1]); + OS3MainFrm.DataGrid.Cells[0,i2+1] := cellstring; + for i := 0 to NoVars -1 do stddevs[i] := RandG(0.0,1.0); + for i := 0 to NoVars - 1 do + begin + x := 0.0; + for j := 0 to i do x := x + (RhoMat[i,j] * stddevs[j]); + mean := StrToFloat(Grid.Cells[i+1,NoVars+1]); + cellstring := format('%10.3f',[x+mean]); + OS3MainFrm.DataGrid.Cells[i+1,i2+1] := cellstring; + end; // next variable + end; // next observation + end; // if abs(determ > .00001) + + // if perturbation elected, convert generated data to z scores and perturb + // with the selected perturbation coefficients + if PerturbChk.Checked then + begin + for i := 1 to NoVars do + begin + means[i-1] := 0.0; + stddevs[i-1] := 0.0; + end; + for i := 1 to NoVars do + begin + for j := 1 to NoObs do + begin + x := StrToFloat(OS3MainFrm.DataGrid.Cells[i,j]); + means[i-1] := means[i-1] + x; + stddevs[i-1] := stddevs[i-1] + (x * x); + end; + stddevs[i-1] := stddevs[i-1] - (means[i-1] * means[i-1] / NoObs); + stddevs[i-1] := stddevs[i-1] / (NoObs - 1); + stddevs[i-1] := sqrt(stddevs[i-1]); + means[i-1] := means[i-1] / NoObs; + OS3MainFrm.DataGrid.Cells[NoVars+i,0] := OS3MainFrm.DataGrid.Cells[i,0] + 'Z'; + end; + for i := 1 to NoVars do + begin + for j := 1 to NoObs do + begin + x := StrToFloat(OS3MainFrm.DataGrid.Cells[i,j]); + x := (x - means[i-1]) / stddevs[i-1]; + OS3MainFrm.DataGrid.Cells[NoVars+i,j] := FloatToStr(x); + end; + end; + // Now, show perturbation options form and select coefficients + + end; // end if perturbchk is checked + + // print parameters if checked + if ParmsChk.Checked then + begin + for i := 1 to NoVars do + for j := 1 to NoVars do RhoMat[i-1,j-1] := StrToFloat(Grid.Cells[i,j]); + for i := 1 to NoVars do + begin + Mus[i-1] := StrToFloat(Grid.Cells[i,NoVars+1]); + Sigmas[i-1] := StrToFloat(Grid.Cells[i,NoVars+2]); + end; + title := 'Rho Matrix'; + MAT_PRINT(RhoMat,NoVars,NoVars,title,RowLabels,ColLabels,NoObs); + title := 'Population Means'; + DynVectorPrint(Mus,NoVars,title,RowLabels,NoObs); + title := 'Sigmas'; + DynVectorPrint(Sigmas,NoVars,title,RowLabels,NoObs); + OutputFrm.ShowModal; + end; + + // do sample values if checked + if SampleChk.Checked then + begin + OutputFrm.RichEdit.Clear; + for i := 1 to NoVars do + begin + for j := 1 to NoVars do SampMat[i-1,j-1] := 0.0; + means[i-1] := 0.0; + stddevs[i-1] := 0.0; + end; + for i := 1 to NoObs do + begin + for j := 0 to NoVars - 1 do + begin + x := StrToFloat(OS3MainFrm.DataGrid.Cells[j+1,i]); + for k := 0 to NoVars - 1 do + begin // cross-products matrix + y := StrToFloat(OS3MainFrm.DataGrid.Cells[k+1,i]); + SampMat[j,k] := SampMat[j,k] + (x * y); + end; + means[j] := means[j] + x; + end; + end; + // variance - covariance matrix + for i := 0 to NoVars - 1 do + begin + for j := 0 to NoVars - 1 do + begin + SampMat[i,j] := SampMat[i,j] - (means[i] * means[j] / NoObs); + SampMat[i,j] := SampMat[i,j] / (NoObs - 1.0); + end; + stddevs[i] := sqrt(SampMat[i][i]); + end; + for i := 0 to NoVars - 1 do + begin + for j := 0 to NoVars - 1 do + begin // correlation matrix + SampMat[i,j] := SampMat[i,j] / (stddevs[i] * stddevs[j]); + end; + means[i] := means[i] / NoObs; + end; + title := 'Sample r Matrix'; + MAT_PRINT(SampMat,NoVars,NoVars,title,RowLabels,ColLabels,NoObs); + title := 'Sample Means'; + DynVectorPrint(means,NoVars,title,RowLabels,NoObs); + title := 'Standard Deviations'; + DynVectorPrint(stddevs,NoVars,title,RowLabels,NoObs); + OutputFrm.ShowModal; + end; + + // dispose of arrays + ColLabels := nil; + RowLabels := nil; + stddevs := nil; + Sigmas := nil; + means := nil; + Mus := nil; + SampMat := nil; + RhoMat := nil; +end; + +procedure TMultGenFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TMultGenFrm.CancelBtnClick(Sender: TObject); +begin + exit; +end; + +procedure TMultGenFrm.GridKeyPress(Sender: TObject; var Key: char); +begin + gridrow := Grid.Row; + gridcol := Grid.Col; + if ord(Key) = 13 then + begin + if (gridrow <= gridcol) then + begin + grid.Cells[gridrow,gridcol] := grid.Cells[gridcol,gridrow]; + end; + end; +end; + +procedure TMultGenFrm.GridSetEditText(Sender: TObject; ACol, ARow: Integer; + const Value: string); +begin + if (gridrow <= gridcol) then + begin + grid.Cells[gridrow,gridcol] := grid.Cells[gridcol,gridrow]; + end; +end; + +procedure TMultGenFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TMultGenFrm.NoObsEditExit(Sender: TObject); +var + i, j : integer; + cellstring : string; +begin + NoObs := StrToInt(NoObsEdit.Text); + if NoObs > 0 then + begin + OS3MainFrm.DataGrid.RowCount := NoObs + 1; + OS3MainFrm.DataGrid.ColCount := NoVars + 1; + for i := 1 to NoObs do + begin + for j := 1 to NoVars do + begin + OS3MainFrm.DataGrid.Cells[j,i] := ''; + end; + end; + end; + + for j := 1 to NoVars do + begin + cellstring := format('VAR%d',[j]); + OS3MainFrm.DataGrid.Cells[j,0] := cellstring; + end; + + Grid.Cells[0,0] := 'Variable'; + Grid.Cells[0,NoVars+1] := 'Mean'; + Grid.Cells[0,NoVars+2] := 'Std.Dev.'; +end; + +procedure TMultGenFrm.NoObsEditKeyPress(Sender: TObject; var Key: char); +begin + if ord(Key) = 13 then NoObsEditExit(self); +end; + +procedure TMultGenFrm.NoVarsEditExit(Sender: TObject); +var + i: integer; + cellstring : string; +begin + NoVars := StrToInt(NoVarsEdit.Text); + if NoVars > 0 then + begin + Grid.RowCount := NoVars + 3; + Grid.ColCount := NoVars + 1; + for i := 1 to NoVars do + begin + Grid.Cells[i,i] := FloatToStr(1.0); + cellstring := format('VAR%d',[i]); + Grid.Cells[i,0] := cellstring; +{ for j := 1 to NoVars do + begin + if i <> j then + begin + Grid.Cells[i,j] := ''; + Grid.Cells[j,i] := ''; + end; + end; // for j := 1 to NoVars } + end; // for i := 1 to NoVars + + end; // if NoVars > 0 +end; + +procedure TMultGenFrm.NoVarsEditKeyPress(Sender: TObject; var Key: char); +begin + if ord(Key) = 13 then NoVarsEditExit(self); +end; + +initialization + {$I multgenunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/pcurvesunit.lfm b/applications/lazstats/source/forms/simulations/pcurvesunit.lfm new file mode 100644 index 000000000..9f23fece1 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/pcurvesunit.lfm @@ -0,0 +1,250 @@ +object PCurvesFrm: TPCurvesFrm + Left = 446 + Height = 215 + Top = 161 + Width = 380 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Power Analysis for a z Test' + ClientHeight = 215 + ClientWidth = 380 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = NullEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 12 + Width = 151 + BorderSpacing.Left = 12 + Caption = 'Mean of the Null Hypothesis' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = SDEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 43 + Width = 199 + BorderSpacing.Left = 12 + Caption = 'Standard Deviation of the Distribution' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = NEdit + AnchorSideTop.Side = asrCenter + Left = 12 + Height = 15 + Top = 74 + Width = 62 + BorderSpacing.Left = 12 + Caption = 'Sample Size' + ParentColor = False + end + object NullEdit: TEdit + AnchorSideLeft.Control = SDEdit + AnchorSideTop.Control = Owner + Left = 219 + Height = 23 + Top = 8 + Width = 53 + Alignment = taRightJustify + BorderSpacing.Top = 8 + TabOrder = 0 + Text = 'NullEdit' + end + object SDEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NullEdit + AnchorSideTop.Side = asrBottom + Left = 219 + Height = 23 + Top = 39 + Width = 53 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 1 + Text = 'Edit1' + end + object NEdit: TEdit + AnchorSideLeft.Control = SDEdit + AnchorSideTop.Control = SDEdit + AnchorSideTop.Side = asrBottom + Left = 219 + Height = 23 + Top = 70 + Width = 53 + Alignment = taRightJustify + BorderSpacing.Top = 8 + TabOrder = 2 + Text = 'Edit1' + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = NEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NEdit + AnchorSideRight.Side = asrBottom + Left = 12 + Height = 82 + Top = 109 + Width = 260 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 16 + BorderSpacing.Bottom = 12 + Caption = 'Probability of a Type I Error:' + ChildSizing.TopBottomSpacing = 8 + ChildSizing.VerticalSpacing = 8 + ChildSizing.EnlargeHorizontal = crsHomogenousSpaceResize + ChildSizing.EnlargeVertical = crsHomogenousSpaceResize + ChildSizing.ShrinkVertical = crsHomogenousSpaceResize + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 2 + ClientHeight = 62 + ClientWidth = 256 + TabOrder = 3 + object Prob01: TCheckBox + Left = 31 + Height = 19 + Top = 8 + Width = 47 + Caption = '0.01' + TabOrder = 0 + end + object Prob025: TCheckBox + Left = 31 + Height = 19 + Top = 35 + Width = 47 + Caption = '0.025' + TabOrder = 1 + end + object Prob05: TCheckBox + Left = 109 + Height = 19 + Top = 8 + Width = 47 + Caption = '0.05' + TabOrder = 2 + end + object Prob075: TCheckBox + Left = 109 + Height = 19 + Top = 35 + Width = 47 + Caption = '0.075' + TabOrder = 3 + end + object Prob10: TCheckBox + Left = 187 + Height = 19 + Top = 8 + Width = 41 + Caption = '0.10' + TabOrder = 4 + end + object Prob20: TCheckBox + Left = 187 + Height = 19 + Top = 35 + Width = 41 + Caption = '0.20' + TabOrder = 5 + end + end + object Panel1: TPanel + AnchorSideLeft.Control = NullEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + AnchorSideBottom.Control = GroupBox1 + AnchorSideBottom.Side = asrBottom + Left = 288 + Height = 191 + Top = 0 + Width = 76 + Anchors = [akTop, akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Right = 12 + BevelOuter = bvNone + ChildSizing.ControlsPerLine = 1 + ClientHeight = 191 + ClientWidth = 76 + TabOrder = 4 + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CancelBtn + Left = 0 + Height = 25 + Top = 55 + Width = 76 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Bottom = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 0 + end + object CancelBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ComputeBtn + Left = 0 + Height = 25 + Top = 92 + Width = 76 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Bottom = 12 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 25 + Top = 129 + Width = 76 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Bottom = 12 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object ReturnBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel1 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 25 + Top = 166 + Width = 76 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + Caption = 'Return' + ModalResult = 1 + TabOrder = 3 + end + end +end diff --git a/applications/lazstats/source/forms/simulations/pcurvesunit.pas b/applications/lazstats/source/forms/simulations/pcurvesunit.pas new file mode 100644 index 000000000..ebcc6bb65 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/pcurvesunit.pas @@ -0,0 +1,236 @@ +unit PCurvesUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + GraphLib, OutputUnit, FunctionsLib, Globals; + +type + + { TPCurvesFrm } + + TPCurvesFrm = class(TForm) + Panel1: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + Prob01: TCheckBox; + Prob025: TCheckBox; + Prob05: TCheckBox; + Prob075: TCheckBox; + Prob10: TCheckBox; + Prob20: TCheckBox; + NullEdit: TEdit; + SDEdit: TEdit; + NEdit: TEdit; + GroupBox1: TGroupBox; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + PCurvesFrm: TPCurvesFrm; + +implementation + +{ TPCurvesFrm } + +procedure TPCurvesFrm.ResetBtnClick(Sender: TObject); +begin + Prob01.Checked := false; + Prob025.Checked := false; + Prob05.Checked := false; + Prob075.Checked := false; + Prob10.Checked := false; + Prob20.Checked := false; + NullEdit.Text := ''; + SDEdit.Text := ''; + NEdit.Text := ''; + NullEdit.SetFocus; +end; + +procedure TPCurvesFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TPCurvesFrm.ComputeBtnClick(Sender: TObject); +var + mean, stddev, N, increment, althyp, power, zbeta, beta, StdErr : double; + XMax, offset : double; + ii : integer; + j, NoPlots, SetNo : integer; + alphas : array[1..6] of double; + zalphas : array[1..6] of double; + xalphas : array[1..6] of double; + XPlotPts : DblDyneMat; + YPlotPts : DblDyneMat; + LabelStr, outline, xTitle, yTitle : string; + oldCursor : TCursor; +begin + SetLength(YPlotPts,6,80); + SetLength(XPlotPts,1,80); + + XMax := 0.0; + mean := StrToFloat(NullEdit.Text); + stddev := StrToFloat(SDEdit.Text); + N := StrToFloat(NEdit.Text); + StdErr := stddev / sqrt(N); // standard error of mean; + increment := 4.0 * StdErr / 80.0; //scale for 80 points + + // Initialize alternative type I error arrays + for ii := 1 to 6 do + begin + alphas[ii] := 0.0; + zalphas[ii] := 0.0; + xalphas[ii] := 0.0; + end; + + // Get the desired alpha (Beta) curve options + if (Prob01.Checked) then alphas[1] := 0.01; + if (Prob025.Checked) then alphas[2] := 0.025; + if (Prob05.Checked) then alphas[3] := 0.05; + if (Prob075.Checked) then alphas[4] := 0.075; + if (Prob10.Checked) then alphas[5] := 0.10; + if (Prob20.Checked) then alphas[6] := 0.20; + oldCursor := Screen.Cursor; + Screen.Cursor := TCursor(crHourGlass); + + // For curves selected, obtain corresponding z and x values + for ii := 1 to 6 do + begin + if (alphas[ii] <> 0.0) then + begin + zalphas[ii] := inversez(1.0 - alphas[ii]); + xalphas[ii] := (zalphas[ii] * StdErr) + mean; + if (xalphas[ii] > XMax) then XMax := xalphas[ii]; + end; + end; + + // For each curve, obtain and plot 80 alternative hypotheses and + // their corresponding probabilities + NoPlots := 1; + for ii := 1 to 6 do // possible curves + begin + if (alphas[ii] <> 0.0) then // curve selected? + begin + Offset := 0.0; + for j := 1 to 80 do //get points to plot + begin + althyp := mean + Offset; + zbeta := (xalphas[ii] - althyp ) / StdErr; + if ( abs(zbeta) < 5.0) then beta := probz(zbeta) + else beta := 0.0; + power := 1.0 - beta; + XPlotPts[0,j-1] := althyp; + YPlotPts[NoPlots-1,j-1] := power; + Offset := offset + increment; + end; + NoPlots := NoPlots + 1; + end; // if alphas[i] <> 0 + end; // next curve i + + // Plot the points + GraphFrm.BackColor := clWhite; + GraphFrm.ShowLeftWall := true; + GraphFrm.ShowRightWall := true; + GraphFrm.ShowBottomWall := true; + GraphFrm.ShowBackWall := true; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlue; + GraphFrm.FloorColor := clBlue; + outline := format('z-Test Power. Pop. Mean := %6.2f, Sigma := %6.2f, N := %2.0f',[mean,stddev,N]); + GraphFrm.Heading := outline; + xTitle := format('%6.2f x INCREMENT ABOVE HYPOTHESIZED MEAN',[increment]); + GraphFrm.XTitle := xTitle; + yTitle := 'PROBABILITIES'; + GraphFrm.YTitle := yTitle; + GraphFrm.nosets := NoPlots-1; + GraphFrm.nbars := 80; + GraphFrm.barwideprop := 0.5; + GraphFrm.miny := 0.0; + GraphFrm.maxy := 1.0; + GraphFrm.AutoScaled := false; + GraphFrm.GraphType := 5; // 2d line charts + GraphFrm.PtLabels := false; + + SetNo := 1; + for ii := 1 to 6 do + begin + if (alphas[ii] <> 0.0) then + begin + LabelStr := format('%4.2f',[alphas[ii]]); + GraphFrm.SetLabels[SetNo] := LabelStr; + SetNo := SetNo + 1; + end; + end; + GraphFrm.Ypoints := YPlotPts; + GraphFrm.Xpoints := XPlotPts; + + Screen.Cursor := oldCursor; + GraphFrm.ShowModal; + + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Power of the z-test for Alternate Hypotheses'); + OutputFrm.RichEdit.Lines.Add(''); + outline := 'Alpha Levels: '; + for ii := 1 to 6 do + begin + if (alphas[ii] <> 0.0) then + begin + LabelStr := format(' %4.2f ',[alphas[ii]]); + outline := outline + LabelStr; + end; + end; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + outline := ''; + for ii := 1 to 80 do + begin + outline := format('X := %6.2f ',[XPlotPts[0,ii-1]]); + SetNo := 1; + for j := 1 to 6 do + begin + if (alphas[j] <> 0.0) then + begin + LabelStr := format('%4.3f ',[YPlotPts[SetNo-1,ii-1]]); + outline := outline + LabelStr; + SetNo := SetNo + 1; + end; + end; + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; + + // clean up the heap + XPlotPts := nil; + YPlotPts := nil; +end; + +procedure TPCurvesFrm.FormCreate(Sender: TObject); +begin + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if GraphFrm = nil then + Application.CreateForm(TGraphFrm, GraphFrm); +end; + +initialization + {$I pcurvesunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/probchisqrunit.lfm b/applications/lazstats/source/forms/simulations/probchisqrunit.lfm new file mode 100644 index 000000000..2337d733a --- /dev/null +++ b/applications/lazstats/source/forms/simulations/probchisqrunit.lfm @@ -0,0 +1,195 @@ +object ChiSqrProbForm: TChiSqrProbForm + Left = 596 + Height = 146 + Top = 281 + Width = 389 + AutoSize = True + BorderStyle = bsSingle + Caption = 'Probability of a chisquared value' + ClientHeight = 146 + ClientWidth = 389 + OnActivate = FormActivate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CancelBtn: TButton + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ResetBtn + Left = 96 + Height = 25 + Top = 109 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Right = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 0 + end + object ResetBtn: TButton + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ComputeBtn + Left = 166 + Height = 25 + Top = 109 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ReturnBtn + Left = 228 + Height = 25 + Top = 109 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 312 + Height = 25 + Top = 109 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 3 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 93 + Width = 389 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 86 + Height = 85 + Top = 8 + Width = 217 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 85 + ClientWidth = 217 + TabOrder = 4 + object Label1: TLabel + AnchorSideTop.Control = ChiSqrEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label3 + AnchorSideRight.Side = asrBottom + Left = 30 + Height = 15 + Top = 4 + Width = 105 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Chisquared value = ' + ParentColor = False + end + object ChiSqrEdit: TEdit + AnchorSideLeft.Control = ProbEdit + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ProbEdit + AnchorSideRight.Side = asrBottom + Left = 143 + Height = 23 + Top = 0 + Width = 74 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + Text = 'ChiSqrEdit' + end + object Label2: TLabel + AnchorSideTop.Control = DFEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label3 + AnchorSideRight.Side = asrBottom + Left = 24 + Height = 15 + Top = 31 + Width = 111 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'with deg. freedom = ' + ParentColor = False + end + object DFEdit: TEdit + AnchorSideLeft.Control = ProbEdit + AnchorSideTop.Control = ChiSqrEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ProbEdit + AnchorSideRight.Side = asrBottom + Left = 143 + Height = 23 + Top = 27 + Width = 74 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 1 + Text = 'DFEdit' + end + object Label3: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ProbEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 66 + Width = 135 + Caption = 'Probability larger value = ' + ParentColor = False + end + object ProbEdit: TEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = DFEdit + AnchorSideTop.Side = asrBottom + Left = 143 + Height = 23 + Top = 62 + Width = 74 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 2 + Text = 'ProbEdit' + end + end +end diff --git a/applications/lazstats/source/forms/simulations/probchisqrunit.pas b/applications/lazstats/source/forms/simulations/probchisqrunit.pas new file mode 100644 index 000000000..555ea96bf --- /dev/null +++ b/applications/lazstats/source/forms/simulations/probchisqrunit.pas @@ -0,0 +1,83 @@ +unit ProbChiSqrUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + FunctionsLib; + +type + + { TChiSqrProbForm } + + TChiSqrProbForm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + ChiSqrEdit: TEdit; + ComputeBtn: TButton; + DFEdit: TEdit; + Panel1: TPanel; + ProbEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + ResetBtn: TButton; + ReturnBtn: TButton; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + ChiSqrProbForm: TChiSqrProbForm; + +implementation + +uses + Math; + +{ TChiSqrProbForm } + +procedure TChiSqrProbForm.ResetBtnClick(Sender: TObject); +begin + ChiSqrEdit.Text := ''; + DFEdit.Text := ''; + ProbEdit.Text := ''; +end; + +procedure TChiSqrProbForm.ComputeBtnClick(Sender: TObject); +VAR + ChiSqr, Prob : double; + DF : integer; + outvalue : string; +begin + ChiSqr := StrToFloat(ChiSqrEdit.Text); + DF := StrToInt(DFEdit.Text); + Prob := 1.0 - chisquaredprob(ChiSqr,DF); + outvalue := format('%6.4f',[Prob]); + ProbEdit.Text := outvalue; +end; + +procedure TChiSqrProbForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([CancelBtn.Width, ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +initialization + {$I probchisqrunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/probsmallerzunit.lfm b/applications/lazstats/source/forms/simulations/probsmallerzunit.lfm new file mode 100644 index 000000000..17c13f1a8 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/probsmallerzunit.lfm @@ -0,0 +1,168 @@ +object ProbSmallerzForm: TProbSmallerzForm + Left = 578 + Height = 110 + Top = 292 + Width = 308 + AutoSize = True + BorderStyle = bsSingle + Caption = 'Probability of a smaller z score' + ClientHeight = 110 + ClientWidth = 308 + OnActivate = FormActivate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ResetBtn + Left = 11 + Height = 25 + Top = 74 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 0 + end + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + Left = 85 + Height = 25 + Top = 74 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 151 + Height = 25 + Top = 74 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 239 + Height = 25 + Top = 74 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 3 + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 57 + Height = 54 + Top = 4 + Width = 194 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 54 + ClientWidth = 194 + TabOrder = 4 + object Label1: TLabel + AnchorSideTop.Control = zEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 4 + Width = 103 + Caption = 'Observed z score = ' + ParentColor = False + end + object zEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + Left = 111 + Height = 23 + Top = 0 + Width = 83 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 0 + Text = 'zEdit' + end + object Label2: TLabel + AnchorSideTop.Control = ProbzEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label1 + AnchorSideRight.Side = asrBottom + Left = 13 + Height = 15 + Top = 35 + Width = 90 + Anchors = [akTop, akRight] + Caption = 'Probability < z = ' + ParentColor = False + end + object ProbzEdit: TEdit + AnchorSideLeft.Control = zEdit + AnchorSideTop.Control = zEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = zEdit + AnchorSideRight.Side = asrBottom + Left = 111 + Height = 23 + Top = 31 + Width = 83 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 1 + Text = 'ProbzEdit' + end + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 58 + Width = 308 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/simulations/probsmallerzunit.pas b/applications/lazstats/source/forms/simulations/probsmallerzunit.pas new file mode 100644 index 000000000..f9563cc5d --- /dev/null +++ b/applications/lazstats/source/forms/simulations/probsmallerzunit.pas @@ -0,0 +1,78 @@ +unit ProbSmallerZUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + Functionslib; + +type + + { TProbSmallerzForm } + + TProbSmallerzForm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + ComputeBtn: TButton; + Label1: TLabel; + Label2: TLabel; + Panel1: TPanel; + ProbzEdit: TEdit; + ResetBtn: TButton; + ReturnBtn: TButton; + zEdit: TEdit; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + ProbSmallerzForm: TProbSmallerzForm; + +implementation + +uses + Math; + +{ TProbSmallerzForm } + +procedure TProbSmallerzForm.ResetBtnClick(Sender: TObject); +begin + zEdit.Text := ''; + ProbzEdit.Text := ''; +end; + +procedure TProbSmallerzForm.ComputeBtnClick(Sender: TObject); +VAR + zprob, z : double; + outvalue : string; +begin + z := StrToFloat(zEdit.Text); + zprob := probz(z); + outvalue := format('%6.4f',[zprob]); + ProbzEdit.Text := outvalue; +end; + +procedure TProbSmallerzForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([CancelBtn.Width, ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +initialization + {$I probsmallerzunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/probzunit.lfm b/applications/lazstats/source/forms/simulations/probzunit.lfm new file mode 100644 index 000000000..07dd9e9ac --- /dev/null +++ b/applications/lazstats/source/forms/simulations/probzunit.lfm @@ -0,0 +1,166 @@ +object ProbzForm: TProbzForm + Left = 238 + Height = 109 + Top = 161 + Width = 311 + AutoSize = True + BorderStyle = bsSingle + Caption = 'Probability of a larger z score' + ClientHeight = 109 + ClientWidth = 311 + OnActivate = FormActivate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ResetBtn + Left = 14 + Height = 25 + Top = 79 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 0 + end + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + Left = 88 + Height = 25 + Top = 79 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 154 + Height = 25 + Top = 79 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 242 + Height = 25 + Top = 79 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 3 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 63 + Width = 311 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 58 + Height = 55 + Top = 8 + Width = 194 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 55 + ClientWidth = 194 + TabOrder = 4 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = zEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 4 + Width = 103 + Caption = 'Observed z score = ' + ParentColor = False + end + object zEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + Left = 111 + Height = 23 + Top = 0 + Width = 83 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 0 + Text = 'zEdit' + end + object Label2: TLabel + AnchorSideTop.Control = ProbzEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label1 + AnchorSideRight.Side = asrBottom + Left = 13 + Height = 15 + Top = 36 + Width = 90 + Anchors = [akTop, akRight] + Caption = 'Probability > z = ' + ParentColor = False + end + object ProbzEdit: TEdit + AnchorSideLeft.Control = zEdit + AnchorSideRight.Control = zEdit + AnchorSideRight.Side = asrBottom + Left = 111 + Height = 23 + Top = 32 + Width = 83 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 1 + Text = 'ProbzEdit' + end + end +end diff --git a/applications/lazstats/source/forms/simulations/probzunit.pas b/applications/lazstats/source/forms/simulations/probzunit.pas new file mode 100644 index 000000000..4f94392d5 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/probzunit.pas @@ -0,0 +1,78 @@ +unit ProbZUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + FunctionsLib; + +type + + { TProbzForm } + + TProbzForm = class(TForm) + Bevel1: TBevel; + Panel1: TPanel; + ReturnBtn: TButton; + CancelBtn: TButton; + ResetBtn: TButton; + ComputeBtn: TButton; + ProbzEdit: TEdit; + Label2: TLabel; + zEdit: TEdit; + Label1: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + ProbzForm: TProbzForm; + +implementation + +uses + Math; + +{ TProbzForm } + +procedure TProbzForm.ResetBtnClick(Sender: TObject); +begin + zEdit.Text := ''; + ProbzEdit.Text := ''; +end; + +procedure TProbzForm.ComputeBtnClick(Sender: TObject); +VAR + zprob, z : double; + outvalue : string; +begin + z := StrToFloat(zEdit.Text); + zprob := 1.0 - probz(z); + outvalue := format('%6.4f',[zprob]); + ProbzEdit.Text := outvalue; +end; + +procedure TProbzForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([CancelBtn.Width, ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +initialization + {$I probzunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/tprobunit.lfm b/applications/lazstats/source/forms/simulations/tprobunit.lfm new file mode 100644 index 000000000..e140ffa1c --- /dev/null +++ b/applications/lazstats/source/forms/simulations/tprobunit.lfm @@ -0,0 +1,199 @@ +object TprobForm: TTprobForm + Left = 528 + Height = 147 + Top = 281 + Width = 391 + AutoSize = True + BorderStyle = bsSingle + Caption = 'Probability of a larger t value' + ClientHeight = 147 + ClientWidth = 391 + OnActivate = FormActivate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ResetBtn + Left = 86 + Height = 25 + Top = 109 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 0 + end + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + Left = 160 + Height = 25 + Top = 109 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 226 + Height = 25 + Top = 109 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 314 + Height = 25 + Top = 109 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 3 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 93 + Width = 391 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 87 + Height = 85 + Top = 8 + Width = 217 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 85 + ClientWidth = 217 + TabOrder = 4 + object Label1: TLabel + AnchorSideTop.Control = tValueEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label3 + AnchorSideRight.Side = asrBottom + Left = 42 + Height = 15 + Top = 4 + Width = 93 + Anchors = [akTop, akRight] + Caption = 'Student t value = ' + ParentColor = False + end + object tValueEdit: TEdit + AnchorSideLeft.Control = ProbEdit + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ProbEdit + AnchorSideRight.Side = asrBottom + Left = 143 + Height = 23 + Top = 0 + Width = 74 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + Text = 'tValueEdit' + end + object Label2: TLabel + AnchorSideTop.Control = DFEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label3 + AnchorSideRight.Side = asrBottom + Left = 24 + Height = 15 + Top = 31 + Width = 111 + Anchors = [akTop, akRight] + Caption = 'with deg. freedom = ' + ParentColor = False + end + object DFEdit: TEdit + AnchorSideLeft.Control = ProbEdit + AnchorSideTop.Control = tValueEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ProbEdit + AnchorSideRight.Side = asrBottom + Left = 143 + Height = 23 + Top = 27 + Width = 74 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 1 + Text = 'DFEdit' + end + object Label3: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ProbEdit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 66 + Width = 135 + Caption = 'Probability larger value = ' + ParentColor = False + end + object ProbEdit: TEdit + AnchorSideLeft.Control = Label3 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = DFEdit + AnchorSideTop.Side = asrBottom + Left = 143 + Height = 23 + Top = 62 + Width = 74 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 2 + Text = 'ProbEdit' + end + end +end diff --git a/applications/lazstats/source/forms/simulations/tprobunit.pas b/applications/lazstats/source/forms/simulations/tprobunit.pas new file mode 100644 index 000000000..2221e0268 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/tprobunit.pas @@ -0,0 +1,85 @@ +unit tProbUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + Functionslib; + +type + + { TTprobForm } + + TTprobForm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + Panel1: TPanel; + tValueEdit: TEdit; + ComputeBtn: TButton; + DFEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + ProbEdit: TEdit; + ResetBtn: TButton; + ReturnBtn: TButton; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + TprobForm: TTprobForm; + +implementation + +uses + Math; + +{ TTprobForm } + +procedure TTprobForm.ResetBtnClick(Sender: TObject); +begin + tValueEdit.Text := ''; + DFEdit.Text := ''; + ProbEdit.Text := ''; +end; + +procedure TTprobForm.ComputeBtnClick(Sender: TObject); +VAR + tvalue, dfvalue, prob : double; + outvalue : string; +begin + tvalue := StrToFloat(tValueEdit.Text); + dfvalue := StrToFloat(DFEdit.Text); + if tvalue >= 0.0 then prob := 0.5 * probt(tvalue,dfvalue); + if tvalue < 0.0 then prob := 1.0 - probt(tvalue,dfvalue) + + (0.5 * probt(tvalue,dfvalue)) ; + if tvalue = 0.0 then prob := 0.50; + outvalue := format('%6.4f',[prob]); + ProbEdit.Text := outvalue; +end; + +procedure TTprobForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([CancelBtn.Width, ResetBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; +end; + +initialization + {$I tprobunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/simulations/twozprobunit.lfm b/applications/lazstats/source/forms/simulations/twozprobunit.lfm new file mode 100644 index 000000000..e694e6cb4 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/twozprobunit.lfm @@ -0,0 +1,197 @@ +object TwozProbForm: TTwozProbForm + Left = 524 + Height = 147 + Top = 287 + Width = 378 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Probability between two z scores' + ClientHeight = 147 + ClientWidth = 378 + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ResetBtn + Left = 57 + Height = 25 + Top = 109 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 32 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 0 + end + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ComputeBtn + Left = 131 + Height = 25 + Top = 109 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = ReturnBtn + Left = 197 + Height = 25 + Top = 109 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 285 + Height = 25 + Top = 109 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 32 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 3 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 93 + Width = 378 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 74 + Height = 85 + Top = 8 + Width = 231 + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ClientHeight = 85 + ClientWidth = 231 + TabOrder = 4 + object Label1: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Z1Edit + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 15 + Top = 4 + Width = 155 + Caption = 'The probability between z1 = ' + ParentColor = False + end + object Z1Edit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + Left = 163 + Height = 23 + Top = 0 + Width = 68 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 0 + Text = 'Z1Edit' + end + object Label2: TLabel + AnchorSideTop.Control = Z2Edit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label1 + AnchorSideRight.Side = asrBottom + Left = 107 + Height = 15 + Top = 31 + Width = 48 + Anchors = [akTop, akRight] + Caption = 'and z2 = ' + ParentColor = False + end + object Z2Edit: TEdit + AnchorSideLeft.Control = Z1Edit + AnchorSideTop.Control = Z1Edit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Z1Edit + AnchorSideRight.Side = asrBottom + Left = 163 + Height = 23 + Top = 27 + Width = 68 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 1 + Text = 'Z2Edit' + end + object Label3: TLabel + AnchorSideTop.Control = ProbEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label1 + AnchorSideRight.Side = asrBottom + Left = 84 + Height = 15 + Top = 66 + Width = 71 + Anchors = [akTop, akRight] + Caption = 'Probability = ' + ParentColor = False + end + object ProbEdit: TEdit + AnchorSideLeft.Control = Z1Edit + AnchorSideTop.Control = Z2Edit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Z1Edit + AnchorSideRight.Side = asrBottom + Left = 163 + Height = 23 + Top = 62 + Width = 68 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 12 + Font.Style = [fsBold] + ParentFont = False + ReadOnly = True + TabOrder = 2 + Text = 'ProbEdit' + end + end +end diff --git a/applications/lazstats/source/forms/simulations/twozprobunit.pas b/applications/lazstats/source/forms/simulations/twozprobunit.pas new file mode 100644 index 000000000..e15d281a3 --- /dev/null +++ b/applications/lazstats/source/forms/simulations/twozprobunit.pas @@ -0,0 +1,74 @@ +unit TwoZProbUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + FunctionsLib; + +type + + { TTwozProbForm } + + TTwozProbForm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + Panel1: TPanel; + ResetBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + ProbEdit: TEdit; + Label3: TLabel; + Z2Edit: TEdit; + Label2: TLabel; + Z1Edit: TEdit; + Label1: TLabel; + procedure ComputeBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + TwozProbForm: TTwozProbForm; + +implementation + +{ TTwozProbForm } + +procedure TTwozProbForm.ResetBtnClick(Sender: TObject); +begin + ProbEdit.Text := ''; + Z1Edit.Text := ''; + Z2Edit.Text := ''; +end; + +procedure TTwozProbForm.ComputeBtnClick(Sender: TObject); +VAR + z1, z2, prob : double; + outvalue : string; +begin + z1 := StrToFloat(Z1Edit.Text); + z2 := StrToFloat(Z2Edit.Text); + if z1 < z2 then + begin + prob := probz(z2) - probz(z1); + end; + if z1 > z2 then + begin + prob := probz(z1) - probz(z2); + end; + outvalue := format('%6.4f',[prob]); + ProbEdit.Text := outvalue; +end; + +initialization + {$I twozprobunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/tools/calculatorunit.lfm b/applications/lazstats/source/forms/tools/calculatorunit.lfm new file mode 100644 index 000000000..0eea8c639 --- /dev/null +++ b/applications/lazstats/source/forms/tools/calculatorunit.lfm @@ -0,0 +1,512 @@ +object CalculatorForm: TCalculatorForm + Left = 572 + Height = 498 + Top = 180 + Width = 364 + AutoSize = True + Caption = 'Calculator' + ClientHeight = 498 + ClientWidth = 364 + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = XEdit + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 223 + Top = 231 + Width = 256 + BorderSpacing.Left = 8 + BorderSpacing.Top = 16 + Caption = 'KeyPad' + ChildSizing.LeftRightSpacing = 8 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 8 + ChildSizing.VerticalSpacing = 8 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsHomogenousChildResize + ChildSizing.ShrinkVertical = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 4 + ClientHeight = 203 + ClientWidth = 252 + TabOrder = 0 + object sevenbtn: TButton + Left = 8 + Height = 41 + Top = 8 + Width = 52 + Caption = '7' + OnClick = sevenbtnClick + TabOrder = 0 + end + object eightbtn: TButton + Left = 68 + Height = 41 + Top = 8 + Width = 58 + Caption = '8' + OnClick = eightbtnClick + TabOrder = 2 + end + object ninebtn: TButton + Left = 134 + Height = 41 + Top = 8 + Width = 52 + Caption = ' 9 ' + OnClick = ninebtnClick + TabOrder = 3 + end + object dividebtn: TButton + Left = 194 + Height = 41 + Top = 8 + Width = 50 + Caption = ' / ' + OnClick = dividebtnClick + TabOrder = 1 + end + object fourbtn: TButton + Left = 8 + Height = 41 + Top = 57 + Width = 52 + Caption = '4' + OnClick = fourbtnClick + TabOrder = 4 + end + object fivebtn: TButton + Left = 68 + Height = 41 + Top = 57 + Width = 58 + Caption = '5' + OnClick = fivebtnClick + TabOrder = 5 + end + object sixbtn: TButton + Left = 134 + Height = 41 + Top = 57 + Width = 52 + Caption = '6' + OnClick = sixbtnClick + TabOrder = 6 + end + object multbtn: TButton + Left = 194 + Height = 41 + Top = 57 + Width = 50 + Caption = '*' + OnClick = multbtnClick + TabOrder = 7 + end + object onebtn: TButton + Left = 8 + Height = 41 + Top = 106 + Width = 52 + Caption = '1' + OnClick = onebtnClick + TabOrder = 8 + end + object twobtn: TButton + Left = 68 + Height = 41 + Top = 106 + Width = 58 + Caption = '2' + OnClick = twobtnClick + TabOrder = 9 + end + object threebtn: TButton + Left = 134 + Height = 41 + Top = 106 + Width = 52 + Caption = '3' + OnClick = threebtnClick + TabOrder = 10 + end + object subtractbtn: TButton + Left = 194 + Height = 41 + Top = 106 + Width = 50 + Caption = '-' + OnClick = subtractbtnClick + TabOrder = 11 + end + object ZeroBtn: TButton + Left = 8 + Height = 40 + Top = 155 + Width = 52 + Caption = ' 0 ' + OnClick = ZeroBtnClick + TabOrder = 12 + end + object ChangeSignBtn: TButton + Left = 68 + Height = 40 + Top = 155 + Width = 58 + Caption = '+/-' + OnClick = ChangeSignBtnClick + TabOrder = 13 + end + object PeriodBtn: TButton + Left = 134 + Height = 40 + Top = 155 + Width = 52 + Caption = '.' + OnClick = PeriodBtnClick + TabOrder = 15 + end + object Addbtn: TButton + Left = 194 + Height = 40 + Top = 155 + Width = 50 + Caption = '+' + OnClick = AddbtnClick + TabOrder = 14 + end + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = GroupBox1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = GroupBox1 + AnchorSideBottom.Control = GroupBox1 + AnchorSideBottom.Side = asrBottom + Left = 280 + Height = 222 + Top = 231 + Width = 71 + BorderSpacing.Left = 16 + BorderSpacing.Right = 8 + Caption = 'Memory' + ChildSizing.LeftRightSpacing = 8 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 8 + ChildSizing.VerticalSpacing = 8 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsHomogenousChildResize + ChildSizing.ShrinkVertical = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 202 + ClientWidth = 67 + TabOrder = 1 + object MemInBtn: TButton + Left = 8 + Height = 41 + Top = 8 + Width = 51 + Caption = 'X->M' + OnClick = MemInBtnClick + TabOrder = 0 + end + object MemOutBtn: TButton + Left = 8 + Height = 41 + Top = 57 + Width = 51 + Caption = 'M->X' + OnClick = MemOutBtnClick + TabOrder = 1 + end + object MemPlusBtn: TButton + Left = 8 + Height = 41 + Top = 106 + Width = 51 + Caption = 'M+' + OnClick = MemPlusBtnClick + TabOrder = 2 + end + object EqualBtn: TButton + Left = 8 + Height = 39 + Top = 155 + Width = 51 + Caption = '=' + OnClick = EqualBtnClick + TabOrder = 3 + end + end + object XEdit: TEdit + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = GroupBox3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 23 + Top = 192 + Width = 348 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 24 + BorderSpacing.Right = 8 + OnKeyPress = XEditKeyPress + TabOrder = 2 + Text = 'XEdit' + end + object GroupBox3: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 160 + Top = 8 + Width = 348 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Functions' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 4 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 5 + ClientHeight = 140 + ClientWidth = 344 + TabOrder = 3 + object sinbtn: TButton + Left = 4 + Height = 30 + Top = 4 + Width = 65 + Caption = 'sin' + OnClick = sinbtnClick + TabOrder = 0 + end + object cosbtn: TButton + Left = 73 + Height = 30 + Top = 4 + Width = 60 + Caption = 'cos' + OnClick = cosbtnClick + TabOrder = 1 + end + object tanbtn: TButton + Left = 137 + Height = 30 + Top = 4 + Width = 78 + Caption = 'tan' + OnClick = tanbtnClick + TabOrder = 2 + end + object Combobtn: TButton + Left = 219 + Height = 30 + Top = 4 + Width = 55 + Caption = 'nCr' + OnClick = CombobtnClick + TabOrder = 3 + end + object ClearEntryBtn: TButton + Left = 278 + Height = 30 + Top = 4 + Width = 62 + Caption = 'CE' + OnClick = ClearEntryBtnClick + TabOrder = 4 + end + object MeanBtn: TButton + Left = 4 + Height = 30 + Top = 38 + Width = 65 + Caption = 'Mean' + OnClick = MeanBtnClick + TabOrder = 5 + end + object VarBtn: TButton + Left = 73 + Height = 30 + Top = 38 + Width = 60 + Caption = 'VAR.' + OnClick = VarBtnClick + TabOrder = 6 + end + object StdDevBtn: TButton + Left = 137 + Height = 30 + Top = 38 + Width = 78 + Caption = 'Std.Dev.' + OnClick = StdDevBtnClick + TabOrder = 7 + end + object natlogbtn: TButton + Left = 219 + Height = 30 + Top = 38 + Width = 55 + Caption = 'ln' + OnClick = natlogbtnClick + TabOrder = 8 + end + object log10btn: TButton + Left = 278 + Height = 30 + Top = 38 + Width = 62 + Caption = 'log10' + OnClick = log10btnClick + TabOrder = 9 + end + object sqrbtn: TButton + Left = 4 + Height = 30 + Top = 72 + Width = 65 + Caption = 'x^2' + OnClick = sqrbtnClick + TabOrder = 10 + end + object sqrtbtn: TButton + Left = 73 + Height = 30 + Top = 72 + Width = 60 + Caption = 'sqrt' + OnClick = sqrtbtnClick + TabOrder = 11 + end + object ytopowerxbtn: TButton + Left = 137 + Height = 30 + Top = 72 + Width = 78 + Caption = 'y^x' + OnClick = ytopowerxbtnClick + TabOrder = 12 + end + object etoxbtn: TButton + Left = 219 + Height = 30 + Top = 72 + Width = 55 + Caption = 'e^x' + OnClick = etoxbtnClick + TabOrder = 13 + end + object tentoxbtn: TButton + Left = 278 + Height = 30 + Top = 72 + Width = 62 + Caption = '10^x' + OnClick = tentoxbtnClick + TabOrder = 14 + end + object expbtn: TButton + Left = 4 + Height = 30 + Top = 106 + Width = 65 + Caption = 'exp' + OnClick = expbtnClick + TabOrder = 15 + end + object absbtn: TButton + Left = 73 + Height = 30 + Top = 106 + Width = 60 + Caption = 'abs' + OnClick = absbtnClick + TabOrder = 16 + end + object PiBtn: TButton + Left = 137 + Height = 30 + Top = 106 + Width = 78 + Caption = 'Pi' + OnClick = PiBtnClick + TabOrder = 17 + end + object nPrbtn: TButton + Left = 219 + Height = 30 + Top = 106 + Width = 55 + Caption = 'nPr' + OnClick = nPrbtnClick + TabOrder = 18 + end + object nfactorialbtn: TButton + Left = 278 + Height = 30 + Top = 106 + Width = 62 + Caption = 'n!' + OnClick = nfactorialbtnClick + TabOrder = 19 + end + end + object Label1: TLabel + AnchorSideTop.Control = NEdit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = NEdit + Left = 54 + Height = 15 + Top = 467 + Width = 154 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'No. in memory stack (M+) = ' + ParentColor = False + end + object NEdit: TEdit + AnchorSideTop.Control = ReturnBtn + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 216 + Height = 23 + Top = 463 + Width = 48 + Anchors = [akTop, akRight] + TabOrder = 4 + Text = 'NEdit' + end + object ReturnBtn: TButton + AnchorSideTop.Control = GroupBox2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox2 + AnchorSideRight.Side = asrBottom + Left = 282 + Height = 26 + Top = 461 + Width = 69 + Anchors = [akTop, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 5 + end +end diff --git a/applications/lazstats/source/forms/tools/calculatorunit.pas b/applications/lazstats/source/forms/tools/calculatorunit.pas new file mode 100644 index 000000000..0bc950837 --- /dev/null +++ b/applications/lazstats/source/forms/tools/calculatorunit.pas @@ -0,0 +1,505 @@ +unit CalculatorUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Math, + FunctionsLib, Globals; + +type + + { TCalculatorForm } + + TCalculatorForm = class(TForm) + ReturnBtn: TButton; + NEdit: TEdit; + Label1: TLabel; + sevenbtn: TButton; + dividebtn: TButton; + multbtn: TButton; + subtractbtn: TButton; + Addbtn: TButton; + ZeroBtn: TButton; + ChangeSignBtn: TButton; + PeriodBtn: TButton; + MemInBtn: TButton; + MemOutBtn: TButton; + MemPlusBtn: TButton; + eightbtn: TButton; + EqualBtn: TButton; + sinbtn: TButton; + cosbtn: TButton; + tanbtn: TButton; + Combobtn: TButton; + ClearEntryBtn: TButton; + MeanBtn: TButton; + VarBtn: TButton; + StdDevBtn: TButton; + natlogbtn: TButton; + ninebtn: TButton; + log10btn: TButton; + sqrbtn: TButton; + sqrtbtn: TButton; + ytopowerxbtn: TButton; + etoxbtn: TButton; + tentoxbtn: TButton; + expbtn: TButton; + absbtn: TButton; + PiBtn: TButton; + nPrbtn: TButton; + fourbtn: TButton; + nfactorialbtn: TButton; + fivebtn: TButton; + sixbtn: TButton; + onebtn: TButton; + twobtn: TButton; + threebtn: TButton; + XEdit: TEdit; + GroupBox1: TGroupBox; + GroupBox2: TGroupBox; + GroupBox3: TGroupBox; + procedure absbtnClick(Sender: TObject); + procedure AddbtnClick(Sender: TObject); + procedure ChangeSignBtnClick(Sender: TObject); + procedure etoxbtnClick(Sender: TObject); + procedure PiBtnClick(Sender: TObject); + procedure VarBtnClick(Sender: TObject); + procedure MeanBtnClick(Sender: TObject); + procedure StdDevBtnClick(Sender: TObject); + procedure ClearEntryBtnClick(Sender: TObject); + procedure CombobtnClick(Sender: TObject); + procedure cosbtnClick(Sender: TObject); + procedure dividebtnClick(Sender: TObject); + procedure eightbtnClick(Sender: TObject); + procedure EqualBtnClick(Sender: TObject); + procedure expbtnClick(Sender: TObject); + procedure fivebtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure fourbtnClick(Sender: TObject); + procedure log10btnClick(Sender: TObject); + procedure MemInBtnClick(Sender: TObject); + procedure MemOutBtnClick(Sender: TObject); + procedure MemPlusBtnClick(Sender: TObject); + procedure multbtnClick(Sender: TObject); + procedure natlogbtnClick(Sender: TObject); + procedure nfactorialbtnClick(Sender: TObject); + procedure ninebtnClick(Sender: TObject); + procedure nPrbtnClick(Sender: TObject); + procedure onebtnClick(Sender: TObject); + procedure PeriodBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure sevenbtnClick(Sender: TObject); + procedure sinbtnClick(Sender: TObject); + procedure sixbtnClick(Sender: TObject); + procedure sqrbtnClick(Sender: TObject); + procedure sqrtbtnClick(Sender: TObject); + procedure subtractbtnClick(Sender: TObject); + procedure tanbtnClick(Sender: TObject); + procedure tentoxbtnClick(Sender: TObject); + procedure threebtnClick(Sender: TObject); + procedure twobtnClick(Sender: TObject); + procedure XEditKeyPress(Sender: TObject; var Key: char); + procedure ytopowerxbtnClick(Sender: TObject); + procedure ZeroBtnClick(Sender: TObject); + private + { private declarations } + Xmemory : double; // value in the memory + X : double; // value in register + TempX : double; // temporary storage of last entry + keyentered : double; // numeric key press value + operation : integer; // operation to be performed upon press of equal sign + NoStack : integer; // no. in memory stack + stack : DblDyneVec; + Xint, Xint2 : integer; + public + { public declarations } + end; + +var + CalculatorForm: TCalculatorForm; + +implementation + +{ TCalculatorForm } + +procedure TCalculatorForm.FormShow(Sender: TObject); +begin + XEdit.Text := ''; + Xmemory := 0.0; + X := 0.0; + keyentered := 0.0; + NoStack := 0; + SetLength(stack,1000); + NEdit.Text := '0'; + XEdit.SetFocus; +end; + +procedure TCalculatorForm.fourbtnClick(Sender: TObject); +begin + XEdit.Text := XEdit.Text + '4'; +end; + +procedure TCalculatorForm.log10btnClick(Sender: TObject); +begin + X := StrToFloat(XEdit.Text); + X := log10(X); + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.MemInBtnClick(Sender: TObject); +begin + Xmemory := StrToFloat(XEdit.Text); + XEdit.Text := ''; +end; + +procedure TCalculatorForm.MemOutBtnClick(Sender: TObject); +begin + XEdit.Text := FloatToStr(Xmemory); +end; + +procedure TCalculatorForm.MemPlusBtnClick(Sender: TObject); +begin + stack[NoStack] := stack[NoStack] + StrToFloat(XEdit.Text); + NoStack := NoStack + 1; + NEdit.Text := IntToStr(NoStack); + XEdit.Text := ''; +end; + +procedure TCalculatorForm.multbtnClick(Sender: TObject); +begin + TempX := StrToFloat(XEdit.Text); + XEdit.Text := ''; + operation := 2; // multiply +end; + +procedure TCalculatorForm.natlogbtnClick(Sender: TObject); +begin + X := StrToFloat(XEdit.Text); + X := ln(X); + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.nfactorialbtnClick(Sender: TObject); +var n : integer; +begin + n := StrToInt(XEdit.Text); + n := factorial(n); + XEdit.Text := IntToStr(n); +end; + +procedure TCalculatorForm.ninebtnClick(Sender: TObject); +begin + XEdit.Text := XEdit.Text + '9'; +end; + +procedure TCalculatorForm.nPrbtnClick(Sender: TObject); +begin + operation := 7; + Xint := StrToInt(XEdit.Text); + XEdit.Text := ''; +end; + +procedure TCalculatorForm.onebtnClick(Sender: TObject); +begin +XEdit.Text := XEdit.Text + '1'; +end; + +procedure TCalculatorForm.PeriodBtnClick(Sender: TObject); +begin + XEdit.Text := XEdit.Text + '.'; +end; + +procedure TCalculatorForm.ReturnBtnClick(Sender: TObject); +begin + stack := nil; +end; + +procedure TCalculatorForm.sevenbtnClick(Sender: TObject); +begin + XEdit.Text := XEdit.Text + '7'; +end; + +procedure TCalculatorForm.sinbtnClick(Sender: TObject); +begin + X := StrToFloat(XEdit.Text); + X := sin(DegToRad(X)); + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.sixbtnClick(Sender: TObject); +begin + XEdit.Text := XEdit.Text + '6'; +end; + +procedure TCalculatorForm.sqrbtnClick(Sender: TObject); +begin + X := StrToFloat(XEdit.Text); + X := X * X; + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.sqrtbtnClick(Sender: TObject); +begin + X := StrToFloat(XEdit.Text); + X := sqrt(X); + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.subtractbtnClick(Sender: TObject); +begin + TempX := StrToFloat(XEdit.Text); + XEdit.Text := ''; + operation := 3; // subtract +end; + +procedure TCalculatorForm.tanbtnClick(Sender: TObject); +begin + X := StrToFloat(XEdit.Text); + X := tan(DegToRad(X)); + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.tentoxbtnClick(Sender: TObject); +begin + X := StrToFloat(XEdit.Text); + X := power(10,X); + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.threebtnClick(Sender: TObject); +begin + XEdit.Text := XEdit.Text + '3'; +end; + +procedure TCalculatorForm.twobtnClick(Sender: TObject); +begin + XEdit.Text := XEdit.Text + '2'; +end; + +procedure TCalculatorForm.XEditKeyPress(Sender: TObject; var Key: char); +begin +// XEdit.Text := XEdit.Text + Key; +end; + +procedure TCalculatorForm.ytopowerxbtnClick(Sender: TObject); +begin + operation := 5; + tempX := StrToFloat(XEdit.Text); + XEdit.Text := ''; +end; + +procedure TCalculatorForm.ZeroBtnClick(Sender: TObject); +begin +XEdit.text := XEdit.Text + '0'; +end; + +procedure TCalculatorForm.ClearEntryBtnClick(Sender: TObject); +begin + XEdit.Text := ''; +end; + +procedure TCalculatorForm.CombobtnClick(Sender: TObject); +begin + operation := 6; + tempX := StrToFloat(XEdit.Text); + XEdit.Text := ''; +end; + +procedure TCalculatorForm.cosbtnClick(Sender: TObject); +begin + X := StrToFloat(XEdit.Text); + X := cos(DegToRad(X)); + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.AddbtnClick(Sender: TObject); +begin + TempX := StrToFloat(XEdit.Text); + XEdit.Text := ''; + operation := 4; // add +end; + +procedure TCalculatorForm.ChangeSignBtnClick(Sender: TObject); +begin + X := StrToFloat(XEdit.Text); + X := -1.0 * X; + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.etoxbtnClick(Sender: TObject); +begin + X := StrToFloat(XEdit.Text); + X := power(2.71828182845905,X); + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.PiBtnClick(Sender: TObject); +begin + X := Pi; + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.absbtnClick(Sender: TObject); +begin + X := StrToFloat(XEdit.Text); + X := abs(X); + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.VarBtnClick(Sender: TObject); +VAR + Sum, SSQ : double; + Ncount : double; + i, index : integer; +begin + Ncount := StrToFloat(NEdit.Text); + index := StrToInt(NEdit.Text); + Sum := 0.0; + SSQ := 0.0; + if Ncount < 1 then + begin + ShowMessage('No values in stack memory'); + exit; + end + else + begin + for i := 0 to index - 1 do + begin + Sum := Sum + stack[i]; + SSQ := SSQ + (stack[i] * stack[i]); + end; +// Sum := Sum / Ncount; // mean +// SSQ := SSQ / Ncount; + SSQ := SSQ - (Sum * Sum) / Ncount; + SSQ := SSQ / (Ncount - 1.0); + XEdit.Text := FloatToStr(SSQ); + end; +end; + +procedure TCalculatorForm.MeanBtnClick(Sender: TObject); +Var + Sum : double; + Ncount : double; + i, index : integer; +begin + Ncount := StrToFloat(NEdit.Text); + index := StrToInt(NEdit.Text); + Sum := 0.0; + if Ncount < 1 then + begin + ShowMessage('No values in stack memory'); + exit; + end + else + begin + for i := 0 to index - 1 do Sum := Sum + stack[i]; + Sum := Sum / Ncount; + XEdit.Text := FloatToStr(Sum); + end; +end; + +procedure TCalculatorForm.StdDevBtnClick(Sender: TObject); +VAR + Sum, SSQ : double; + Ncount : double; + i, index : integer; +begin + Ncount := StrToFloat(NEdit.Text); + index := StrToInt(NEdit.Text); + Sum := 0.0; + SSQ := 0.0; + if Ncount < 1 then + begin + ShowMessage('No values in stack memory'); + exit; + end + else + begin + for i := 0 to index - 1 do + begin + Sum := Sum + stack[i]; + SSQ := SSQ + (stack[i] * stack[i]); + end; +// Sum := Sum / Ncount; // mean +// SSQ := SSQ / Ncount; + SSQ := SSQ - (Sum * Sum) / Ncount; + SSQ := SSQ / (Ncount - 1.0); + SSQ := sqrt(SSQ); + XEdit.Text := FloatToStr(SSQ); + end; +end; + +procedure TCalculatorForm.dividebtnClick(Sender: TObject); +begin + TempX := StrToFloat(XEdit.Text); + XEdit.Text := ''; + operation := 1; // //divide +end; + +procedure TCalculatorForm.eightbtnClick(Sender: TObject); +begin + XEdit.Text := XEdit.Text + '8'; +end; + +procedure TCalculatorForm.EqualBtnClick(Sender: TObject); +Var x1, x2 : double; +begin + case (operation) of + 1 : begin // divide operation + x1 := tempX; + x2 := x1 / StrToFloat(XEdit.Text); + XEdit.Text := FloatToStr(x2); + end; + 2 : begin // nultiply operation + x1 := tempX; + x2 := x1 * StrToFloat(XEdit.Text); + XEdit.Text := FloatToStr(x2); + end; + 3 : begin + x1 := tempX; // subtract operation + x2 := x1 - StrToFloat(XEdit.Text); + XEdit.Text := FloatToStr(x2); + end; + 4 : begin + x1 := tempX; // Add operation + x2 := x1 + StrToFloat(XEdit.Text); + XEdit.Text := FloatToStr(x2); + end; + 5 : begin // y to the X power (Y stored in tempx first, x in register) + X := StrToFloat(XEdit.Text); + X := power(tempX,X); + XEdit.Text := FloatToStr(X); + end; + 6 : begin // combinations of x things out of N + X := StrToFloat(XEdit.Text); + X := combos(X,tempX); + XEdit.Text := FloatToStr(X); + end; + 7 : begin // permutations of x things out of N + Xint2 := StrToInt(XEdit.Text); + Xint := factorial(Xint) div (factorial(Xint - Xint2)); + XEdit.Text := IntToStr(Xint); + end; + end; +end; + +procedure TCalculatorForm.expbtnClick(Sender: TObject); +begin + X := StrToFloat(XEdit.Text); + X := exp(X); + XEdit.Text := FloatToStr(X); +end; + +procedure TCalculatorForm.fivebtnClick(Sender: TObject); +begin + XEdit.Text := XEdit.Text + '5'; +end; + +initialization + {$I calculatorunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/tools/datasmoothunit.lfm b/applications/lazstats/source/forms/tools/datasmoothunit.lfm new file mode 100644 index 000000000..6b58b565c --- /dev/null +++ b/applications/lazstats/source/forms/tools/datasmoothunit.lfm @@ -0,0 +1,237 @@ +object SmoothDataForm: TSmoothDataForm + Left = 511 + Height = 386 + Top = 190 + Width = 387 + Caption = 'Data Smoothing' + ClientHeight = 386 + ClientWidth = 387 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label2: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 15 + Top = 95 + Width = 46 + BorderSpacing.Left = 8 + BorderSpacing.Top = 12 + Caption = 'Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = InBtn + AnchorSideBottom.Control = Bevel2 + Left = 8 + Height = 225 + Top = 112 + Width = 163 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = VarList + Left = 179 + Height = 28 + Top = 112 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 1 + end + object OutBtn: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + Left = 179 + Height = 28 + Top = 144 + Width = 28 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object VariableEdit: TEdit + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 215 + Height = 23 + Top = 131 + Width = 164 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + TabOrder = 3 + Text = 'VariableEdit' + end + object Label1: TLabel + AnchorSideLeft.Control = VarList + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = RepeatEdit + AnchorSideTop.Side = asrCenter + Left = 179 + Height = 15 + Top = 302 + Width = 100 + BorderSpacing.Left = 8 + Caption = 'Repeat smoothing ' + ParentColor = False + end + object RepeatEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + AnchorSideTop.Side = asrCenter + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 287 + Height = 23 + Top = 298 + Width = 31 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 16 + TabOrder = 4 + Text = 'RepeatEdit' + end + object Label3: TLabel + AnchorSideLeft.Control = RepeatEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label1 + Left = 326 + Height = 15 + Top = 302 + Width = 32 + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'times.' + ParentColor = False + end + object ResetBtn: TButton + AnchorSideTop.Control = ComputeBtn + AnchorSideRight.Control = CancelBtn + Left = 163 + Height = 25 + Top = 353 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object CancelBtn: TButton + AnchorSideTop.Control = ComputeBtn + AnchorSideRight.Control = ComputeBtn + Left = 229 + Height = 25 + Top = 353 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 6 + end + object ComputeBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 303 + Height = 25 + Top = 353 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + ModalResult = 1 + OnClick = ComputeBtnClick + TabOrder = 7 + end + object HelpBtn: TButton + Tag = 119 + AnchorSideTop.Control = ComputeBtn + AnchorSideRight.Control = ResetBtn + Left = 100 + Height = 25 + Top = 353 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 8 + end + object Bevel1: TBevel + AnchorSideLeft.Control = InBtn + AnchorSideTop.Control = InBtn + AnchorSideTop.Side = asrBottom + Left = 179 + Height = 4 + Top = 140 + Width = 28 + Shape = bsSpacer + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ComputeBtn + Left = 0 + Height = 8 + Top = 337 + Width = 387 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 75 + Top = 8 + Width = 371 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'This procedure creates a new variable with the label "smoothed" with data points created from the selected variable. Each new data point is the average of the immediately preceding value and the immediately following value. New values are therefore created for the 2nd, 3rd,...,and N-1 values. The process can be repeated multiple times.' + ParentColor = False + WordWrap = True + end +end diff --git a/applications/lazstats/source/forms/tools/datasmoothunit.pas b/applications/lazstats/source/forms/tools/datasmoothunit.pas new file mode 100644 index 000000000..a2c8c6b91 --- /dev/null +++ b/applications/lazstats/source/forms/tools/datasmoothunit.pas @@ -0,0 +1,167 @@ +unit DataSmoothUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, DictionaryUnit, ContextHelpUnit; + +type + + { TSmoothDataForm } + + TSmoothDataForm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + CancelBtn: TButton; + HelpBtn: TButton; + Label3: TLabel; + ComputeBtn: TButton; + Memo1: TLabel; + RepeatEdit: TEdit; + Label1: TLabel; + ResetBtn: TButton; + VariableEdit: TEdit; + InBtn: TBitBtn; + Label2: TLabel; + OutBtn: TBitBtn; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + SmoothDataForm: TSmoothDataForm; + +implementation + +uses + Math; + +{ TSmoothDataForm } + +procedure TSmoothDataForm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + RepeatEdit.Text := '1'; + VariableEdit.Text := ''; + InBtn.Enabled := true; + OutBtn.Enabled := false; +end; + +procedure TSmoothDataForm.InBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + VariableEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + InBtn.Enabled := false; + OutBtn.Enabled := true; +end; + +procedure TSmoothDataForm.ComputeBtnClick(Sender: TObject); +VAR + DataPts, OutPts : DblDyneVec; + value, avg : double; + VarCol, N, Reps, i, j, col : integer; + varlabel, strvalue : string; +begin + N := NoCases; + SetLength(DataPts,N); + SetLength(OutPts,N); + Reps := StrToInt(RepeatEdit.Text); + varlabel := VariableEdit.Text; + for i := 1 to NoVariables do + if varlabel = OS3MainFrm.DataGrid.Cells[i,0] then VarCol := i; + for i := 1 to N do + begin + value := StrToFloat(OS3MainFrm.DataGrid.Cells[VarCol,i]); + DataPts[i-1] := value; + end; + // repeat smoothing for Reps times + OutPts[0] := DataPts[0]; + OutPts[N-1] := DataPts[N-1]; + for j := 1 to Reps do + begin + for i := 1 to N-2 do + begin + avg := (DataPts[i-1] + DataPts[i] + DataPts[i+1]) / 3.0; + OutPts[i] := avg; + end; + if j < Reps then + for i := 0 to N-1 do DataPts[i] := OutPts[i]; + end; + // Create a new variable and copy smoothed data into it. + strvalue := 'Smoothed'; + col := NoVariables + 1; + DictionaryFrm.NewVar(NoVariables+1); + DictionaryFrm.DictGrid.Cells[1,NoVariables] := strvalue; + OS3MainFrm.DataGrid.Cells[NoVariables,0] := strvalue; + for i := 0 to N-1 do OS3MainFrm.DataGrid.Cells[col,i+1] := FloatToStr(OutPts[i]); +end; + +procedure TSmoothDataForm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([HelpBtn.Width, ComputeBtn.Width, ResetBtn.Width, CancelBtn.Width]); + HelpBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TSmoothDataForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TSmoothDataForm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).Tag); +end; + +procedure TSmoothDataForm.OutBtnClick(Sender: TObject); +begin + VarList.Items.Add(VariableEdit.Text); + VariableEdit.Text := ''; + OutBtn.Enabled := false; + InBtn.Enabled := true; +end; + +initialization + {$I datasmoothunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/tools/jpegunit.lfm b/applications/lazstats/source/forms/tools/jpegunit.lfm new file mode 100644 index 000000000..cda954ebd --- /dev/null +++ b/applications/lazstats/source/forms/tools/jpegunit.lfm @@ -0,0 +1,118 @@ +object JPEGform: TJPEGform + Left = 348 + Height = 595 + Top = 154 + Width = 739 + Caption = 'JPEG Viewer' + ClientHeight = 595 + ClientWidth = 739 + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Image1: TImage + Left = 8 + Height = 536 + Top = 8 + Width = 723 + Align = alClient + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Proportional = True + end + object Panel1: TPanel + Left = 8 + Height = 27 + Top = 560 + Width = 723 + Align = alBottom + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 27 + ClientWidth = 723 + TabOrder = 0 + object LoadBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + Left = 0 + Height = 25 + Top = 0 + Width = 88 + AutoSize = True + Caption = 'Load Image' + OnClick = LoadBtnClick + TabOrder = 0 + end + object ReturnBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 662 + Height = 25 + Top = 0 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Return' + ModalResult = 1 + TabOrder = 1 + end + object StretchBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = NormalBtn + Left = 361 + Height = 25 + Top = 0 + Width = 63 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 16 + Caption = 'Stretch' + OnClick = StretchBtnClick + TabOrder = 2 + end + object NormalBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = PropBtn + Left = 440 + Height = 25 + Top = 0 + Width = 66 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 16 + Caption = 'Normal' + OnClick = NormalBtnClick + TabOrder = 3 + end + object PropBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ReturnBtn + Left = 522 + Height = 25 + Top = 0 + Width = 124 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 16 + Caption = 'Show Proportional' + OnClick = PropBtnClick + TabOrder = 4 + end + end + object Bevel1: TBevel + Left = 0 + Height = 8 + Top = 544 + Width = 739 + Align = alBottom + Shape = bsBottomLine + end + object OpenPictureDialog1: TOpenPictureDialog + left = 108 + top = 77 + end +end diff --git a/applications/lazstats/source/forms/tools/jpegunit.pas b/applications/lazstats/source/forms/tools/jpegunit.pas new file mode 100644 index 000000000..72865570a --- /dev/null +++ b/applications/lazstats/source/forms/tools/jpegunit.pas @@ -0,0 +1,85 @@ +unit JpegUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, ExtDlgs; + +type + + { TJPEGform } + + TJPEGform = class(TForm) + Bevel1: TBevel; + Panel1: TPanel; + PropBtn: TButton; + StretchBtn: TButton; + NormalBtn: TButton; + OpenPictureDialog1: TOpenPictureDialog; + ReturnBtn: TButton; + LoadBtn: TButton; + Image1: TImage; + procedure LoadBtnClick(Sender: TObject); + procedure NormalBtnClick(Sender: TObject); + procedure PropBtnClick(Sender: TObject); + procedure StretchBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + JPEGform: TJPEGform; + +implementation + +{ TJPEGform } + +procedure TJPEGform.LoadBtnClick(Sender: TObject); +VAR + JPEG : TJPEGImage; +begin + OpenPictureDialog1.Options := OpenPictureDialog1.Options+[ofFileMustExist]; + if not OpenPictureDialog1.Execute then exit; + try + JPEG := TJPEGImage.Create; + try + JPEG.LoadFromFile(OpenPictureDialog1.FileName); + Image1.Picture.Assign(JPEG); + finally + JPEG.Free; + end; + Caption := OpenPictureDialog1.FileName; + except + on E: Exception do begin + MessageDlg('Error','Error: '+E.Message,mtError,[mbOk],0); + end; + end; +end; + +procedure TJPEGform.NormalBtnClick(Sender: TObject); +begin + Image1.Proportional := false; + Image1.Stretch := false; +end; + +procedure TJPEGform.PropBtnClick(Sender: TObject); +begin + Image1.Proportional := true; +end; + +procedure TJPEGform.StretchBtnClick(Sender: TObject); +begin + Image1.Proportional := false; + Image1.Stretch := true; +end; + +initialization + {$I jpegunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/tools/randomsampunit.lfm b/applications/lazstats/source/forms/tools/randomsampunit.lfm new file mode 100644 index 000000000..1ba73ecc4 --- /dev/null +++ b/applications/lazstats/source/forms/tools/randomsampunit.lfm @@ -0,0 +1,177 @@ +object RandomSampFrm: TRandomSampFrm + Left = 659 + Height = 150 + Top = 405 + Width = 382 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Select Cases Random Sample' + ClientHeight = 150 + ClientWidth = 382 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object GroupBox1: TGroupBox + AnchorSideTop.Control = Owner + Left = 8 + Height = 92 + Top = 8 + Width = 364 + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Sample Size' + ClientHeight = 72 + ClientWidth = 360 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = PcntEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ApproxBtn + AnchorSideTop.Side = asrCenter + Left = 179 + Height = 15 + Top = 10 + Width = 55 + BorderSpacing.Left = 8 + Caption = '% of cases' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = ExactEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ExactBtn + AnchorSideTop.Side = asrCenter + Left = 145 + Height = 15 + Top = 41 + Width = 103 + BorderSpacing.Left = 8 + Caption = 'cases from the first ' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = CasesEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ExactBtn + AnchorSideTop.Side = asrCenter + Left = 317 + Height = 15 + Top = 41 + Width = 31 + BorderSpacing.Left = 8 + BorderSpacing.Right = 12 + Caption = 'cases.' + ParentColor = False + end + object ApproxBtn: TRadioButton + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + Left = 16 + Height = 19 + Top = 8 + Width = 98 + BorderSpacing.Left = 16 + BorderSpacing.Top = 8 + Caption = 'Approximately' + TabOrder = 0 + end + object PcntEdit: TEdit + AnchorSideLeft.Control = ApproxBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ApproxBtn + AnchorSideTop.Side = asrCenter + Left = 122 + Height = 23 + Top = 6 + Width = 49 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 1 + Text = 'PcntEdit' + end + object ExactBtn: TRadioButton + AnchorSideLeft.Control = GroupBox1 + Left = 16 + Height = 19 + Top = 39 + Width = 57 + BorderSpacing.Left = 16 + Caption = 'Exactly' + TabOrder = 2 + end + object ExactEdit: TEdit + AnchorSideLeft.Control = ExactBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ExactBtn + AnchorSideTop.Side = asrCenter + Left = 81 + Height = 23 + Top = 37 + Width = 56 + Alignment = taRightJustify + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 12 + TabOrder = 3 + Text = 'ExactEdit' + end + object CasesEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ExactBtn + AnchorSideTop.Side = asrCenter + Left = 256 + Height = 23 + Top = 37 + Width = 53 + Alignment = taRightJustify + BorderSpacing.Left = 8 + TabOrder = 4 + Text = 'CasesEdit' + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + Left = 89 + Height = 25 + Top = 111 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 16 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + object CancelBtn: TButton + AnchorSideLeft.Control = GroupBox1 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = GroupBox1 + AnchorSideTop.Side = asrBottom + Left = 159 + Height = 25 + Top = 112 + Width = 62 + AutoSize = True + BorderSpacing.Top = 12 + BorderSpacing.Bottom = 12 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object OKBtn: TButton + AnchorSideLeft.Control = CancelBtn + AnchorSideLeft.Side = asrBottom + Left = 237 + Height = 25 + Top = 112 + Width = 42 + AutoSize = True + BorderSpacing.Left = 16 + Caption = 'OK' + ModalResult = 1 + TabOrder = 3 + end +end diff --git a/applications/lazstats/source/forms/tools/randomsampunit.pas b/applications/lazstats/source/forms/tools/randomsampunit.pas new file mode 100644 index 000000000..31ecb35cf --- /dev/null +++ b/applications/lazstats/source/forms/tools/randomsampunit.pas @@ -0,0 +1,74 @@ +unit RandomSampUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls; + +type + + { TRandomSampFrm } + + TRandomSampFrm = class(TForm) + ResetBtn: TButton; + CancelBtn: TButton; + OKBtn: TButton; + CasesEdit: TEdit; + ExactEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + PcntEdit: TEdit; + GroupBox1: TGroupBox; + ApproxBtn: TRadioButton; + ExactBtn: TRadioButton; + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + RandomSampFrm: TRandomSampFrm; + +implementation + +uses + Math; + +{ TRandomSampFrm } + +procedure TRandomSampFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, CancelBtn.Width, OKBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + OKBtn.Constraints.MinWidth := w; +end; + +procedure TRandomSampFrm.FormShow(Sender: TObject); +begin + PcntEdit.Text := ''; + ExactEdit.Text := ''; + CasesEdit.Text := ''; + ApproxBtn.Checked := true; +end; + +procedure TRandomSampFrm.ResetBtnClick(Sender: TObject); +begin + FormShow(self); +end; + +initialization + {$I randomsampunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/tools/rangeselectunit.lfm b/applications/lazstats/source/forms/tools/rangeselectunit.lfm new file mode 100644 index 000000000..6e41a1352 --- /dev/null +++ b/applications/lazstats/source/forms/tools/rangeselectunit.lfm @@ -0,0 +1,140 @@ +object RangeSelectFrm: TRangeSelectFrm + Left = 583 + Height = 111 + Top = 344 + Width = 344 + AutoSize = True + BorderStyle = bsDialog + Caption = 'Select Cases for a Range of Cases' + ClientHeight = 111 + ClientWidth = 344 + OnActivate = FormActivate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = FirstCaseEdit + AnchorSideTop.Side = asrCenter + Left = 16 + Height = 15 + Top = 33 + Width = 101 + BorderSpacing.Left = 16 + Caption = 'Select Cases From: ' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = FirstCaseEdit + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 124 + Height = 15 + Top = 12 + Width = 81 + BorderSpacing.Top = 12 + Caption = 'First Case Label' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = LastCaseEdit + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + Left = 229 + Height = 15 + Top = 12 + Width = 80 + BorderSpacing.Top = 12 + Caption = 'Last Case Label' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = FirstCaseEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = FirstCaseEdit + AnchorSideTop.Side = asrCenter + Left = 211 + Height = 15 + Top = 33 + Width = 11 + BorderSpacing.Left = 8 + Caption = 'to' + ParentColor = False + end + object FirstCaseEdit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + Left = 125 + Height = 23 + Top = 29 + Width = 78 + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + TabOrder = 0 + Text = 'FirstCaseEdit' + end + object LastCaseEdit: TEdit + AnchorSideLeft.Control = Label4 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = FirstCaseEdit + Left = 230 + Height = 23 + Top = 29 + Width = 78 + BorderSpacing.Left = 8 + BorderSpacing.Right = 16 + TabOrder = 1 + Text = 'Edit1' + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = OKBtn + Left = 220 + Height = 25 + Top = 72 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object OKBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 294 + Height = 25 + Top = 72 + Width = 42 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'OK' + ModalResult = 1 + TabOrder = 3 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = FirstCaseEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 12 + Top = 52 + Width = 344 + Anchors = [akTop, akLeft, akRight] + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/tools/rangeselectunit.pas b/applications/lazstats/source/forms/tools/rangeselectunit.pas new file mode 100644 index 000000000..afa8881db --- /dev/null +++ b/applications/lazstats/source/forms/tools/rangeselectunit.pas @@ -0,0 +1,62 @@ +unit RangeSelectUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls; + +type + + { TRangeSelectFrm } + + TRangeSelectFrm = class(TForm) + Bevel1: TBevel; + CancelBtn: TButton; + Label4: TLabel; + OKBtn: TButton; + FirstCaseEdit: TEdit; + LastCaseEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + procedure FormActivate(Sender: TObject); + procedure FormShow(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + RangeSelectFrm: TRangeSelectFrm; + +implementation + +uses + Math; + +{ TRangeSelectFrm } + +procedure TRangeSelectFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([CancelBtn.Width, OKBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + OKBtn.Constraints.MinWidth := w; +end; + +procedure TRangeSelectFrm.FormShow(Sender: TObject); +begin + FirstCaseEdit.Text := ''; + LastCaseEdit.Text := ''; +end; + +initialization + {$I rangeselectunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/tools/selectcasesunit.lfm b/applications/lazstats/source/forms/tools/selectcasesunit.lfm new file mode 100644 index 000000000..42b2859ee --- /dev/null +++ b/applications/lazstats/source/forms/tools/selectcasesunit.lfm @@ -0,0 +1,419 @@ +object SelectFrm: TSelectFrm + Left = 541 + Height = 382 + Top = 241 + Width = 830 + Caption = 'Select Cases' + ClientHeight = 382 + ClientWidth = 830 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 46 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 306 + Top = 25 + Width = 160 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + TabOrder = 0 + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = VarList + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + Left = 176 + Height = 205 + Top = 25 + Width = 166 + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Select:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.VerticalSpacing = 6 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 185 + ClientWidth = 162 + TabOrder = 1 + object AllCasesBtn: TRadioButton + Left = 12 + Height = 19 + Top = 8 + Width = 138 + Caption = 'All Cases' + OnClick = AllCasesBtnClick + TabOrder = 0 + end + object IfCondBtn: TRadioButton + Left = 12 + Height = 19 + Top = 33 + Width = 138 + Caption = 'If condition is satisfied' + OnClick = IfCondBtnClick + TabOrder = 1 + end + object RandomBtn: TRadioButton + Left = 12 + Height = 19 + Top = 58 + Width = 138 + Caption = 'A Random Sample' + OnClick = RandomBtnClick + TabOrder = 2 + end + object RangeBtn: TRadioButton + Left = 12 + Height = 19 + Top = 83 + Width = 138 + Caption = 'A Range of Cases' + OnClick = RangeBtnClick + TabOrder = 3 + end + object FilterBtn: TRadioButton + Left = 12 + Height = 19 + Top = 108 + Width = 138 + Caption = 'Use the Filter Variable' + OnClick = FilterBtnClick + TabOrder = 4 + end + object Label2: TLabel + Left = 12 + Height = 15 + Top = 133 + Width = 138 + Caption = 'Click one from the list' + ParentColor = False + end + object FiltVarEdit: TEdit + Left = 12 + Height = 23 + Top = 154 + Width = 138 + TabOrder = 5 + Text = 'FiltVarEdit' + end + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = VarList + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 176 + Height = 78 + Top = 240 + Width = 166 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Unselected Cases Are:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.VerticalSpacing = 4 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 58 + ClientWidth = 162 + TabOrder = 2 + object FilterOutBtn: TRadioButton + Left = 12 + Height = 19 + Top = 8 + Width = 130 + Caption = 'Filtered Out' + TabOrder = 0 + end + object DeleteBtn: TRadioButton + Left = 12 + Height = 19 + Top = 31 + Width = 130 + Caption = 'Deleted from the File' + TabOrder = 1 + end + end + object ResetBtn: TButton + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 529 + Height = 25 + Top = 348 + Width = 54 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 9 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 9 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 3 + end + object CancelBtn: TButton + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 595 + Height = 25 + Top = 348 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 9 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 9 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 4 + end + object ComputeBtn: TButton + AnchorSideRight.Control = ReturnBtn + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 669 + Height = 25 + Top = 348 + Width = 76 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 9 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 9 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 5 + end + object ReturnBtn: TButton + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 757 + Height = 25 + Top = 348 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 9 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 9 + Caption = 'Return' + ModalResult = 1 + TabOrder = 6 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 331 + Width = 830 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Panel1: TPanel + AnchorSideLeft.Control = GroupBox1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 350 + Height = 323 + Top = 8 + Width = 472 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 12 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 4 + ClientHeight = 323 + ClientWidth = 472 + TabOrder = 7 + object Panel2: TPanel + Left = 0 + Height = 323 + Top = 0 + Width = 109 + BevelOuter = bvNone + ClientHeight = 323 + ClientWidth = 109 + TabOrder = 0 + object Label3: TLabel + AnchorSideTop.Control = Panel2 + Left = 8 + Height = 15 + Top = 0 + Width = 51 + Caption = 'Left Value' + Constraints.MaxHeight = 20 + ParentColor = False + end + object ExpListBox: TListBox + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel2 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 306 + Top = 17 + Width = 109 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + ItemHeight = 0 + TabOrder = 0 + end + end + object Panel3: TPanel + Left = 121 + Height = 323 + Top = 0 + Width = 109 + BevelOuter = bvNone + ClientHeight = 323 + ClientWidth = 109 + TabOrder = 1 + object Label4: TLabel + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = Panel3 + Left = 0 + Height = 15 + Top = 0 + Width = 65 + Caption = 'Comparison' + Constraints.MaxHeight = 20 + ParentColor = False + end + object JoinList: TListBox + AnchorSideLeft.Control = Panel3 + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel3 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel3 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 306 + Top = 17 + Width = 109 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + ItemHeight = 0 + TabOrder = 0 + end + end + object Panel4: TPanel + Left = 242 + Height = 323 + Top = 0 + Width = 109 + BevelOuter = bvNone + ClientHeight = 323 + ClientWidth = 109 + TabOrder = 2 + object Label5: TLabel + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = Panel4 + Left = 0 + Height = 15 + Top = 0 + Width = 59 + Caption = 'Right Value' + Constraints.MaxHeight = 20 + ParentColor = False + end + object NotList: TListBox + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = Label5 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel4 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel4 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 306 + Top = 17 + Width = 109 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + ItemHeight = 0 + TabOrder = 0 + end + end + object Panel5: TPanel + Left = 363 + Height = 323 + Top = 0 + Width = 109 + BevelOuter = bvNone + ClientHeight = 323 + ClientWidth = 109 + TabOrder = 3 + object Label6: TLabel + AnchorSideLeft.Control = Panel5 + AnchorSideTop.Control = Panel5 + Left = 0 + Height = 15 + Top = 0 + Width = 53 + Caption = 'Join Logic' + Constraints.MaxHeight = 20 + ParentColor = False + end + object OpsList: TListBox + AnchorSideLeft.Control = Panel5 + AnchorSideTop.Control = Label6 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel5 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel5 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 306 + Top = 17 + Width = 109 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + ItemHeight = 0 + TabOrder = 0 + end + end + end +end diff --git a/applications/lazstats/source/forms/tools/selectcasesunit.pas b/applications/lazstats/source/forms/tools/selectcasesunit.pas new file mode 100644 index 000000000..46d0a26cf --- /dev/null +++ b/applications/lazstats/source/forms/tools/selectcasesunit.pas @@ -0,0 +1,495 @@ +unit SelectCasesUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + MainUnit, OutputUnit, Globals, DataProcs, + DictionaryUnit, SelectIfUnit, RandomSampUnit, RangeSelectUnit; + +type + + { TSelectFrm } + + TSelectFrm = class(TForm) + Bevel1: TBevel; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + Panel4: TPanel; + Panel5: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + FiltVarEdit: TEdit; + GroupBox1: TGroupBox; + GroupBox2: TGroupBox; + Label1: TLabel; + AllCasesBtn: TRadioButton; + IfCondBtn: TRadioButton; + FilterBtn: TRadioButton; + Label2: TLabel; + FilterOutBtn: TRadioButton; + DeleteBtn: TRadioButton; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + ExpListBox: TListBox; + JoinList: TListBox; + NotList: TListBox; + OpsList: TListBox; + RandomBtn: TRadioButton; + RangeBtn: TRadioButton; + VarList: TListBox; + procedure AllCasesBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FilterBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure IfCondBtnClick(Sender: TObject); + procedure RandomBtnClick(Sender: TObject); + procedure RangeBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + selectstr: string; + public + { public declarations } + end; + +var + SelectFrm: TSelectFrm; + +implementation + +uses + Math; + +{ TSelectFrm } + +procedure TSelectFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + NOTList.Clear; + ExpListBox.Clear; + JoinList.Clear; + OpsList.Clear; + AllCasesBtn.Checked := true; + FilterOutBtn.Checked := true; + FiltVarEdit.Text := ''; + AllCasesBtn.Checked := true; + IfCondBtn.Checked := false; + RandomBtn.Checked := false; + RangeBtn.Checked := false; + FilterBtn.Checked := false; + FilterOutBtn.Checked := true; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TSelectFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + ResetBtn.Constraints.MinWidth := w; + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := True; +end; + +procedure TSelectFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryfrm, DictionaryFrm); + if SelectIFFrm = nil then + Application.CreateForm(TSelectIfFrm, SelectIfFrm); + if RandomSampFrm = nil then + Application.CreateForm(TRandomSampFrm, RandomSampFrm); + if RangeSelectFrm = nil then + Application.CreateForm(TRangeSelectFrm, RangeSelectFrm); +end; + +procedure TSelectFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TSelectFrm.IfCondBtnClick(Sender: TObject); +begin + if SelectIfFrm.ShowModal = mrCancel then + exit; + SelectStr := SelectIfFrm.IFString; +end; + +procedure TSelectFrm.RandomBtnClick(Sender: TObject); +begin + if RandomSampFrm.ShowModal = mrCancel then exit; +end; + +procedure TSelectFrm.RangeBtnClick(Sender: TObject); +begin + if RangeSelectFrm.ShowModal = mrCancel then + exit; +end; + +procedure TSelectFrm.AllCasesBtnClick(Sender: TObject); +begin + FilterOutBtn.Checked := false; + DeleteBtn.Checked := false; +end; + +procedure TSelectFrm.ComputeBtnClick(Sender: TObject); +var + cellstring, outline, FirstCase, LastCase, filtvar : string; + FilterVar : boolean; + FilterDel : boolean; + IfFilter : boolean; + RandomFilter : boolean; + RangeFilter : boolean; + AllCases : boolean; + testresult, Truth : boolean; + TValue : array[1..20] of boolean; + i, j, filtcol, firstrow, lastrow, norndm, caserow, cases : integer; + NoExpr, delrow : integer; + pcntrndm : double; + Expression : string; // main select if string + leftstr, rightstr, opstr : string; + ExpList, LeftValue, RightValue, JoinOps, Ops, VarLabels : StrDyneVec; +begin + FilterVar := false; // true if a filter variable is selected to use + FilterDel := false; // true if deleting non-selected cases + IfFilter := false; // true if a select if option is used + FilterOn := false; // set to no filtering + RandomFilter := false; // true if random selected cases is used + RangeFilter := false; // true if a range of cases are selected + AllCases := true; // default when selecting all cases + outline := ''; + filtcol := 0; + lastrow := 0; + if FilterCol > 0 then filtcol := FilterCol; + + if AllCasesBtn.Checked then + begin + FilterOn := false; + OS3MainFrm.FilterEdit.Text := 'OFF'; + exit; + end; + + if FilterBtn.Checked then // use filter variable + begin + cellstring := FiltVarEdit.Text; + FilterVar := true; + AllCases := false; + FilterOn := true; // global value + OS3MainFrm.FilterEdit.Text := 'ON'; + FilterDel := false; + if DeleteBtn.Checked then FilterDel := true; + end; + + if IfCondBtn.Checked then + begin + IfFilter := true; +// FilterOn := true; + OS3MainFrm.FilterEdit.Text := 'ON'; + AllCases := false; + if DeleteBtn.Checked then FilterDel := true + else FilterDel := false; + end; + + if RandomBtn.Checked then + begin + RandomFilter := true; + AllCases := false; + FilterOn := true; + OS3MainFrm.FilterEdit.Text := 'ON'; + if DeleteBtn.Checked then FilterDel := true else FilterDel := false; + end; + + if RangeBtn.Checked then + begin + RangeFilter := true; + FilterOn := true; + OS3MainFrm.FilterEdit.Text := 'ON'; + AllCases := false; + if DeleteBtn.Checked then FilterDel := true else FilterDel := false; + end; + + if FilterOutBtn.Checked then + begin +// FilterOn := true; + OS3MainFrm.FilterEdit.Text := 'ON'; + end; + + if Not FilterOn and AllCases then exit // no current filtering + else + begin + if (RangeFilter) or (RandomFilter) or (IfFilter) then + begin + if filtcol = 0 then + begin + // create a filter variable and select cases + filtcol := NoVariables + 1; + outline := format('Filter%d',[NoVariables]); + OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 1; + OS3MainFrm.DataGrid.Cells[filtcol,0] := outline; + // update the dictionary + DictionaryFrm.DictGrid.RowCount := filtcol + 1; + DictionaryFrm.DictGrid.Cells[0,filtcol] := IntToStr(filtcol); + DictionaryFrm.DictGrid.Cells[2,filtcol] := 'Filter'; + DictionaryFrm.DictGrid.Cells[3,filtcol] := '3'; + DictionaryFrm.DictGrid.Cells[4,filtcol] := 'S'; + DictionaryFrm.DictGrid.Cells[5,filtcol] := '0'; + DictionaryFrm.DictGrid.Cells[6,filtcol] := ' '; + DictionaryFrm.DictGrid.Cells[7,filtcol] := 'L'; + varDefined[filtcol] := true; + OS3MainFrm.NoVarsEdit.Text := IntToStr(filtcol); + NoVariables := filtcol; + end; + end; + + // select cases using the method selected + if RangeFilter then + begin + FirstCase := Trim(RangeSelectFrm.FirstCaseEdit.Text); + LastCase := Trim(RangeSelectFrm.LastCaseEdit.Text); + outline := 'RangeFilter'; + OS3MainFrm.DataGrid.Cells[filtcol,0] := outline; + DictionaryFrm.DictGrid.Cells[1,filtcol] := outline; + // find first case + firstrow := NoCases; + for i := 1 to NoCases do + begin + if FirstCase = Trim(OS3MainFrm.DataGrid.Cells[0,i]) then // matched! + begin + OS3MainFrm.DataGrid.Cells[filtcol,i] := 'YES'; + firstrow := i; + break; + end + else OS3MainFrm.DataGrid.Cells[filtcol,i] := 'NO'; + end; + for i := firstrow + 1 to NoCases do + begin + if LastCase = Trim(OS3MainFrm.DataGrid.Cells[0,i]) then //matched + begin + OS3MainFrm.DataGrid.Cells[filtcol,i] := 'YES'; + lastrow := i; + break; + end + else OS3MainFrm.DataGrid.Cells[filtcol,i] := 'YES'; + end; + for i := lastrow + 1 to NoCases do + OS3MainFrm.DataGrid.Cells[filtcol,i] := 'NO'; + end; // end if range filtering + + if RandomFilter then + begin + outline := 'RandomFilter'; + OS3MainFrm.DataGrid.Cells[filtcol,0] := outline; + DictionaryFrm.DictGrid.Cells[1,filtcol] := outline; + Randomize; + if RandomSampFrm.ApproxBtn.Checked then + begin + pcntrndm := StrToFloat(RandomSampFrm.PcntEdit.Text); + norndm := round((pcntrndm / 100.0) * NoCases); + i := norndm; + while i > 0 do + begin + caserow := random(NoCases-1) + 1; + if OS3MainFrm.DataGrid.Cells[filtcol,caserow] <> 'YES' then + begin + OS3MainFrm.DataGrid.Cells[filtcol,caserow] := 'YES'; + i := i - 1; + end; + end; + end + else // exact no from first N cases + begin + norndm := StrToInt(RandomSampFrm.ExactEdit.Text); + cases := StrToInt(RandomSampFrm.CasesEdit.Text); + i := norndm; + while i > 0 do + begin + caserow := random(cases-1) + 1; + if OS3MainFrm.DataGrid.Cells[filtcol,caserow] <> 'YES' then + begin + OS3MainFrm.DataGrid.Cells[filtcol,caserow] := 'YES'; + i := i - 1; + end; + end; + end; + // put No in all without a Yes + for i := 1 to NoCases do + if OS3MainFrm.DataGrid.Cells[filtcol,i] <> 'YES' then + OS3MainFrm.DataGrid.Cells[filtcol,i] := 'NO'; + end; // end if random filtering + + if FilterVar then // use an existing filter variable + begin + filtvar := Trim(FiltVarEdit.Text); + // find column of the variable + filtcol := 0; + for i := 1 to NoVariables do + begin + cellstring := Trim(OS3MainFrm.DataGrid.Cells[i,0]); + if cellstring = filtvar then + begin + filtcol := i; + break; + end; + end; + FilterCol := filtcol; + if filtcol = 0 then + begin + FilterOn := false; // bad filter column + OS3MainFrm.FilterEdit.Text := 'OFF'; + end; + end; // end if filter variable + + if IfFilter then // user chose the select if button + begin + SetLength(ExpList, 20); + SetLength(LeftValue, 20); + SetLength(RightValue, 20); + SetLength(JoinOps, 20); + SetLength(Ops, 20); + SetLength(VarLabels, NoVariables); + for i := 0 to 19 do + begin + ExpList[i] := ''; + LeftValue[i] := ''; + RightValue[i] := ''; + JoinOps[i] := ''; + Ops[i] := ''; + end; + for i := 0 to NoVariables-1 do + VarLabels[i] := OS3MainFrm.DataGrid.Cells[i+1,0]; + outline := 'IfFilter'; + OS3MainFrm.DataGrid.Cells[filtcol,0] := outline; + DictionaryFrm.DictGrid.Cells[1,filtcol] := outline; + Expression := SelectIfFrm.ifstring; + SelectIfFrm.parse(Expression,ExpList,NoExpr,Ops,LeftValue,RightValue,JoinOps); + // Now, for each sub-expression, check left and right values for + // matches to a variable or numeric value and apply the operation + // to each record in the grid. + for i := 0 to NoExpr-1 do + begin + ExpListBox.Items.Add(Ops[i]); + NOTList.Items.Add(LeftValue[i]); + JoinList.Items.Add(RightValue[i]); + OpsList.Items.Add(JoinOps[i]); + end; + + for i := 1 to NoCases do + begin + Truth := false; + TestResult := false; + for j := 0 to NoExpr-1 do + begin + leftstr := LeftValue[j]; + rightstr := RightValue[j]; + opstr := Ops[j]; + TValue[j+1] := SelectIfFrm.TruthValue(i,j,leftstr,rightstr, + opstr, VarLabels, NoVariables); + end; + + // now evalute the truth table using joing operations + if NoExpr > 0 then + begin + Truth := false; + for j := 0 to NoExpr-1 do + begin + if JoinOps[j] = '&' then + begin + if TValue[j+1] and TValue[j+2] then + TestResult := true; + end; + if JoinOps[j] = '|' then + begin + if TValue[j+1] or TValue[j+2] then + TestResult := true; + end; + if JoinOps[j] = '!' then + begin + if TValue[j+1] <> TValue[j+2] then + TestResult := true; + end; + if (JoinOps[j] = '') and + (NoExpr = 1) then // no join operation + begin + if TValue[j+1] then TestResult := true; + end; + Truth := TestResult; + end; // next jth expression + end; // last jth expression if NoExpr > 0 + + if Truth then OS3MainFrm.DataGrid.Cells[filtcol,i] := 'YES' + else OS3MainFrm.DataGrid.Cells[filtcol,i] := 'NO'; + end; // next case + + VarLabels := nil; + Ops := nil; + JoinOps := nil; + RightValue := nil; + LeftValue := nil; + ExpList := nil; + FilterCol := filtcol; + FilterOn := true; + end; // select if filtering + + // should we delete the 'NO' cases ? + if FilterDel then + begin + delrow := 1; + while delrow < OS3MainFrm.DataGrid.RowCount do + begin + if OS3MainFrm.DataGrid.Cells[filtcol,delrow] = 'NO' then + begin + OS3MainFrm.DataGrid.Row := delrow; + CutaRow; + end + else delrow := delrow + 1; + end; + end; + end; // else filtering +// SelectFrm.Hide; +end; + +procedure TSelectFrm.FilterBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.ItemIndex; + if index >= 0 then FiltVarEdit.Text := VarList.Items.Strings[index]; + if FiltVarEdit.Text = '' then + begin + ShowMessage('ERROR! First, click the name of a filter variable'); + exit; + end; + FilterOn := true; + for i := 1 to NoVariables do + if OS3MainFrm.DataGrid.Cells[i,0] = FiltVarEdit.Text then FilterCol := i; +end; + + +initialization + {$I selectcasesunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/tools/selectifunit.lfm b/applications/lazstats/source/forms/tools/selectifunit.lfm new file mode 100644 index 000000000..3be7863c3 --- /dev/null +++ b/applications/lazstats/source/forms/tools/selectifunit.lfm @@ -0,0 +1,503 @@ +object SelectIfFrm: TSelectIfFrm + Left = 547 + Height = 395 + Top = 273 + Width = 498 + Caption = 'Select Cases IF' + ClientHeight = 395 + ClientWidth = 498 + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 46 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = SelectMemo + AnchorSideTop.Control = Owner + Left = 192 + Height = 15 + Top = 8 + Width = 79 + BorderSpacing.Top = 8 + Caption = 'Select Cases IF:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 301 + Top = 25 + Width = 140 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + ItemHeight = 0 + TabOrder = 0 + end + object SelectMemo: TMemo + AnchorSideLeft.Control = InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NineBtn + AnchorSideRight.Side = asrBottom + Left = 192 + Height = 91 + Top = 25 + Width = 280 + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + ReadOnly = True + TabOrder = 1 + end + object LeftParenBtn: TBitBtn + AnchorSideLeft.Control = SelectMemo + AnchorSideTop.Control = SelectMemo + AnchorSideTop.Side = asrBottom + Left = 192 + Height = 26 + Top = 132 + Width = 32 + BorderSpacing.Top = 16 + Caption = '(' + OnClick = LeftParenBtnClick + TabOrder = 2 + end + object LessBtn: TBitBtn + AnchorSideLeft.Control = AndBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SelectMemo + AnchorSideTop.Side = asrBottom + Left = 240 + Height = 26 + Top = 132 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '<' + OnClick = LessBtnClick + TabOrder = 3 + end + object GreaterBtn: TBitBtn + AnchorSideLeft.Control = OrBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SelectMemo + AnchorSideTop.Side = asrBottom + Left = 288 + Height = 26 + Top = 132 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '>' + OnClick = GreaterBtnClick + TabOrder = 4 + end + object SevenBtn: TBitBtn + AnchorSideLeft.Control = PlusBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SelectMemo + AnchorSideTop.Side = asrBottom + Left = 344 + Height = 26 + Top = 132 + Width = 32 + BorderSpacing.Left = 24 + BorderSpacing.Top = 16 + Caption = '7' + OnClick = SevenBtnClick + TabOrder = 5 + end + object EightBtn: TBitBtn + AnchorSideLeft.Control = SevenBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SelectMemo + AnchorSideTop.Side = asrBottom + Left = 392 + Height = 26 + Top = 132 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '8' + OnClick = EightBtnClick + TabOrder = 6 + end + object NineBtn: TBitBtn + AnchorSideLeft.Control = EightBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SelectMemo + AnchorSideTop.Side = asrBottom + Left = 440 + Height = 26 + Top = 132 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '9' + OnClick = NineBtnClick + TabOrder = 7 + end + object RightParenBtn: TBitBtn + AnchorSideLeft.Control = SelectMemo + AnchorSideTop.Control = NineBtn + AnchorSideTop.Side = asrBottom + Left = 192 + Height = 26 + Top = 174 + Width = 32 + BorderSpacing.Top = 16 + Caption = ')' + OnClick = RightParenBtnClick + TabOrder = 8 + end + object LEBtn: TBitBtn + AnchorSideLeft.Control = AndBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NineBtn + AnchorSideTop.Side = asrBottom + Left = 240 + Height = 26 + Top = 174 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '<=' + OnClick = LEBtnClick + TabOrder = 9 + end + object GEBtn: TBitBtn + AnchorSideLeft.Control = OrBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NineBtn + AnchorSideTop.Side = asrBottom + Left = 288 + Height = 26 + Top = 174 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '>=' + OnClick = GEBtnClick + TabOrder = 10 + end + object FourBtn: TBitBtn + AnchorSideLeft.Control = PlusBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NineBtn + AnchorSideTop.Side = asrBottom + Left = 344 + Height = 26 + Top = 174 + Width = 32 + BorderSpacing.Left = 24 + BorderSpacing.Top = 16 + Caption = '4' + OnClick = FourBtnClick + TabOrder = 11 + end + object FiveBtn: TBitBtn + AnchorSideLeft.Control = SevenBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NineBtn + AnchorSideTop.Side = asrBottom + Left = 392 + Height = 26 + Top = 174 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '5' + OnClick = FiveBtnClick + TabOrder = 12 + end + object SixBtn: TBitBtn + AnchorSideLeft.Control = EightBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NineBtn + AnchorSideTop.Side = asrBottom + Left = 440 + Height = 26 + Top = 174 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '6' + OnClick = SixBtnClick + TabOrder = 13 + end + object EQBtn: TBitBtn + AnchorSideLeft.Control = SelectMemo + AnchorSideTop.Control = SixBtn + AnchorSideTop.Side = asrBottom + Left = 192 + Height = 26 + Top = 216 + Width = 32 + BorderSpacing.Top = 16 + Caption = '=' + OnClick = EQBtnClick + TabOrder = 14 + end + object NotBtn: TBitBtn + AnchorSideLeft.Control = AndBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SixBtn + AnchorSideTop.Side = asrBottom + Left = 240 + Height = 26 + Top = 216 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '<>' + OnClick = NotBtnClick + TabOrder = 15 + end + object MinusBatn: TBitBtn + AnchorSideLeft.Control = OrBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SixBtn + AnchorSideTop.Side = asrBottom + Left = 288 + Height = 26 + Top = 216 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '-' + OnClick = MinusBatnClick + TabOrder = 16 + end + object OneBtn: TBitBtn + AnchorSideLeft.Control = PlusBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SixBtn + AnchorSideTop.Side = asrBottom + Left = 344 + Height = 26 + Top = 216 + Width = 32 + BorderSpacing.Left = 24 + BorderSpacing.Top = 16 + Caption = '1' + OnClick = OneBtnClick + TabOrder = 17 + end + object TwoBtn: TBitBtn + AnchorSideLeft.Control = SevenBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SixBtn + AnchorSideTop.Side = asrBottom + Left = 392 + Height = 26 + Top = 216 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '2' + OnClick = TwoBtnClick + TabOrder = 18 + end + object ThreeBtn: TBitBtn + AnchorSideLeft.Control = EightBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SixBtn + AnchorSideTop.Side = asrBottom + Left = 440 + Height = 26 + Top = 216 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '3' + OnClick = ThreeBtnClick + TabOrder = 19 + end + object PlusBtn: TBitBtn + AnchorSideLeft.Control = OrBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ThreeBtn + AnchorSideTop.Side = asrBottom + Left = 288 + Height = 26 + Top = 258 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '+' + OnClick = PlusBtnClick + TabOrder = 20 + end + object ZeroBtn: TBitBtn + AnchorSideLeft.Control = PlusBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ThreeBtn + AnchorSideTop.Side = asrBottom + Left = 344 + Height = 26 + Top = 258 + Width = 72 + BorderSpacing.Left = 24 + BorderSpacing.Top = 16 + Caption = '0' + OnClick = ZeroBtnClick + TabOrder = 21 + end + object DotBtn: TBitBtn + AnchorSideLeft.Control = EightBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ThreeBtn + AnchorSideTop.Side = asrBottom + Left = 440 + Height = 26 + Top = 258 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = '.' + OnClick = DotBtnClick + TabOrder = 22 + end + object AndBtn: TBitBtn + AnchorSideLeft.Control = SelectMemo + AnchorSideTop.Control = PlusBtn + AnchorSideTop.Side = asrBottom + Left = 192 + Height = 26 + Top = 300 + Width = 32 + BorderSpacing.Top = 16 + Caption = 'and' + OnClick = AndBtnClick + TabOrder = 23 + end + object OrBtn: TBitBtn + AnchorSideLeft.Control = AndBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = PlusBtn + AnchorSideTop.Side = asrBottom + Left = 240 + Height = 26 + Top = 300 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = 'or' + OnClick = OrBtnClick + TabOrder = 24 + end + object LNotBtn: TBitBtn + AnchorSideLeft.Control = OrBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = PlusBtn + AnchorSideTop.Side = asrBottom + Left = 288 + Height = 26 + Top = 300 + Width = 32 + BorderSpacing.Left = 16 + BorderSpacing.Top = 16 + Caption = 'not' + OnClick = LNotBtnClick + TabOrder = 25 + end + object ResetBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = CancelBtn + Left = 304 + Height = 25 + Top = 358 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 26 + end + object CancelBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = OKBtn + Left = 370 + Height = 25 + Top = 358 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 27 + end + object OKBtn: TButton + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 444 + Height = 25 + Top = 358 + Width = 42 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'OK' + ModalResult = 1 + OnClick = OKBtnClick + TabOrder = 28 + end + object InBtn: TBitBtn + AnchorSideLeft.Control = VarList + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + Left = 156 + Height = 28 + Top = 33 + Width = 28 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = InBtnClick + Spacing = 0 + TabOrder = 29 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = AndBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 8 + Top = 334 + Width = 498 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 16 + Shape = bsBottomLine + end +end diff --git a/applications/lazstats/source/forms/tools/selectifunit.pas b/applications/lazstats/source/forms/tools/selectifunit.pas new file mode 100644 index 000000000..dca757e14 --- /dev/null +++ b/applications/lazstats/source/forms/tools/selectifunit.pas @@ -0,0 +1,808 @@ +unit SelectIfUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, + MainUnit, Globals, DataProcs, OptionsUnit; + +type + + { TSelectIfFrm } + + TSelectIfFrm = class(TForm) + Bevel1: TBevel; + LeftParenBtn: TBitBtn; + FourBtn: TBitBtn; + FiveBtn: TBitBtn; + SixBtn: TBitBtn; + EQBtn: TBitBtn; + NotBtn: TBitBtn; + MinusBatn: TBitBtn; + OneBtn: TBitBtn; + TwoBtn: TBitBtn; + ThreeBtn: TBitBtn; + PlusBtn: TBitBtn; + LessBtn: TBitBtn; + ZeroBtn: TBitBtn; + DotBtn: TBitBtn; + AndBtn: TBitBtn; + OrBtn: TBitBtn; + LNotBtn: TBitBtn; + InBtn: TBitBtn; + GreaterBtn: TBitBtn; + SevenBtn: TBitBtn; + EightBtn: TBitBtn; + NineBtn: TBitBtn; + RightParenBtn: TBitBtn; + LEBtn: TBitBtn; + GEBtn: TBitBtn; + ResetBtn: TButton; + CancelBtn: TButton; + OKBtn: TButton; + Label1: TLabel; + Label2: TLabel; + SelectMemo: TMemo; + VarList: TListBox; + procedure AndBtnClick(Sender: TObject); + procedure CancelBtnClick(Sender: TObject); + procedure DotBtnClick(Sender: TObject); + procedure EightBtnClick(Sender: TObject); + procedure EQBtnClick(Sender: TObject); + procedure FiveBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure FourBtnClick(Sender: TObject); + procedure GEBtnClick(Sender: TObject); + procedure GreaterBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure LEBtnClick(Sender: TObject); + procedure LeftParenBtnClick(Sender: TObject); + procedure LessBtnClick(Sender: TObject); + procedure LNotBtnClick(Sender: TObject); + procedure MinusBatnClick(Sender: TObject); + procedure NineBtnClick(Sender: TObject); + procedure NotBtnClick(Sender: TObject); + procedure OKBtnClick(Sender: TObject); + procedure OneBtnClick(Sender: TObject); + procedure OrBtnClick(Sender: TObject); + procedure PlusBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure RightParenBtnClick(Sender: TObject); + procedure SevenBtnClick(Sender: TObject); + procedure SixBtnClick(Sender: TObject); + procedure ThreeBtnClick(Sender: TObject); + procedure TwoBtnClick(Sender: TObject); + procedure ZeroBtnClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + ifstring : string; + procedure CheckParens(VAR LeftCnt : integer; + VAR RightCnt : integer; + VAR Expression : string); + + procedure GetExpression(VAR Expression : string; + VAR SubExpr : string; + VAR LeftParen : integer; + VAR RightParen : integer); + + procedure DelSubSt(VAR Expression : string; + FromPos, ToPos : integer); + + procedure TrimParens(VAR Expression : string); + + function LeadOp(VAR Expression : string) : integer; + + function OpPosition(VAR Expression : string; + VAR chr : string; + VAR OpLong : integer) : integer; + + procedure RemoveBlanks(VAR Expression : string); + + procedure GetLeftSt(VAR Expression : string; + VAR LeftSt : string; + FromPos : integer); + + procedure GetRightSt(VAR Expression : string; + VAR RightSt : string; + FromPos : integer; + OpLong : integer); + + function isnumeric(VAR Expression : string) : integer; + + function GetVarIndex(VAR varstring : string; + VAR VarLabels : StrDyneVec; + NoVars : integer) : integer; + + procedure BuildIfList(VAR Expression : string; + VAR ExprList : StrDyneVec; + VAR NoExpr : integer; + VAR JoinOps : StrDyneVec); + + procedure parse(VAR Expression : string; + VAR ExprList : StrDyneVec; + VAR NoExpr : integer; + VAR Ops : StrDyneVec; + VAR LeftValue : StrDyneVec; + VAR RightValue : StrDyneVec; + VAR JoinOps : StrDyneVec); + + function TruthValue(caseno, ExpNo : integer; + VAR LeftStr : string; + VAR RightStr : string; + VAR OpCode : string; + VAR VarLabels : StrDyneVec; + NoVars : integer) : boolean; + end; + +var + SelectIfFrm: TSelectIfFrm; + +implementation + +uses + Math, + SelectCasesUnit; + +{ TSelectIfFrm } + +procedure TSelectIfFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + SelectMemo.Clear; + ifstring := '('; + SelectMemo.Lines.Add(ifstring); + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TSelectIfFrm.RightParenBtnClick(Sender: TObject); +begin + ifstring := ifstring + ' ) '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.SevenBtnClick(Sender: TObject); +begin + ifstring := ifstring + '7'; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.SixBtnClick(Sender: TObject); +begin + ifstring := ifstring + '6'; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.ThreeBtnClick(Sender: TObject); +begin + ifstring := ifstring + '3'; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.TwoBtnClick(Sender: TObject); +begin + ifstring := ifstring + '2'; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.ZeroBtnClick(Sender: TObject); +begin + ifstring := ifstring + '0'; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + w := MaxValue([ResetBtn.Width, CancelBtn.Width, OKBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + OkBtn.Constraints.MinWidth := w; +end; + +procedure TSelectIfFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); +end; + +procedure TSelectIfFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); + DotBtn.Caption := FractionTypeChars[Options.FractionType]; +end; + +procedure TSelectIfFrm.FourBtnClick(Sender: TObject); +begin + ifstring := ifstring + '4'; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.EQBtnClick(Sender: TObject); +begin + ifstring := ifstring + ' = '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.FiveBtnClick(Sender: TObject); +begin + ifstring := ifstring + '5'; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.AndBtnClick(Sender: TObject); +begin + ifstring := ifstring + ' & '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.CancelBtnClick(Sender: TObject); +begin + ResetBtnClick(self) ; +end; + +procedure TSelectIfFrm.DotBtnClick(Sender: TObject); +begin + ifstring := ifstring + FractionTypeChars[Options.FractionType]; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.EightBtnClick(Sender: TObject); +begin + ifstring := ifstring + '8'; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.GEBtnClick(Sender: TObject); +begin + ifstring := ifstring + ' >= '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.GreaterBtnClick(Sender: TObject); +begin + ifstring := ifstring + ' > '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.InBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + ifstring := ifstring + ' ' + VarList.Items.Strings[index] + ' '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.LEBtnClick(Sender: TObject); +begin + ifstring := ifstring + ' <= '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.LeftParenBtnClick(Sender: TObject); +begin + ifstring := ifstring + ' ( '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.LessBtnClick(Sender: TObject); +begin + ifstring := ifstring + ' < '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.LNotBtnClick(Sender: TObject); +begin + ifstring := ifstring + ' ! '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.MinusBatnClick(Sender: TObject); +begin + ifstring := ifstring + ' -'; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.NineBtnClick(Sender: TObject); +begin + ifstring := ifstring + '9'; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.NotBtnClick(Sender: TObject); +begin + ifstring := ifstring + ' <> '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.OKBtnClick(Sender: TObject); +begin + SelectFrm.FilterOutBtn.Checked := true; +end; + +procedure TSelectIfFrm.OneBtnClick(Sender: TObject); +begin + ifstring := ifstring + '1'; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.OrBtnClick(Sender: TObject); +begin + ifstring := ifstring + ' | '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.PlusBtnClick(Sender: TObject); +begin + ifstring := ifstring + ' + '; + SelectMemo.Clear; + SelectMemo.Lines.Add(ifstring); +end; + +procedure TSelectIfFrm.CheckParens(var LeftCnt: integer; var RightCnt: integer; + var Expression: string); +VAR i : integer; +begin + LeftCnt := 0; + RightCnt := 0; + + for i := 1 to Length(Expression) do + begin + if Expression[i] = '(' then LeftCnt := LeftCnt + 1; + if Expression[i] = ')' then RightCnt := RightCnt + 1; + end; +end; + +procedure TSelectIfFrm.GetExpression(var Expression: string; + var SubExpr: string; var LeftParen: integer; var RightParen: integer); + VAR i, j : integer; +begin + // Search from left for for first right paren. + // Search back for first left paren (corresponding paren.) + // Extract sub string. + RightParen := 0; + LeftParen := 0; + for i := 1 to Length(Expression) do + begin + if Expression[i] = ')' then + begin + RightParen := i; + break; + end; + end; + + for i := RightParen downto 1 do + begin + if Expression[i] = '(' then + begin + LeftParen := i; + break; + end; + end; + + if RightParen = 0 then // no parentheses - take whole expression + begin + SubExpr := Expression; + exit; + end; + + j := 0; + for i := LeftParen to RightParen do + begin + j := j + 1; + SubExpr := SubExpr + Expression[i]; + end; + SetLength(SubExpr,j); +end; + +procedure TSelectIfFrm.DelSubSt(var Expression: string; FromPos, ToPos: integer + ); +var + stlength : integer; + awidth : integer; + +begin +// tempstr := ''; + stlength := Length(Expression); + if stlength <= (ToPos - FromPos+1) then exit; // whole expression + awidth := ToPos - FromPos + 1; + Delete(Expression,FromPos,awidth); +end; + +procedure TSelectIfFrm.TrimParens(var Expression: string); +var + stlength, i : integer; + +begin + stlength := Length(Expression); + if Expression[stlength] = ')' then // paren at right end of string + SetLength(Expression,stlength-1); + + + stlength := Length(Expression); + if Expression[1] = '(' then // left paren + begin + for i := 1 to stlength - 1 do // copy including null char + Expression[i] := Expression[i+1]; + SetLength(Expression,stlength-1); + end; +end; + +function TSelectIfFrm.LeadOp(var Expression: string): integer; +VAR chr : char; +begin + chr := Expression[1]; + if ( (chr = '|') or (chr = '&') or (chr = '!') )then Result := 1 + else Result := 0; +end; + +function TSelectIfFrm.OpPosition(var Expression: string; var chr: string; + var OpLong: integer): integer; +var + i, pos : integer; + achar : char; + +begin + pos := -1; + chr := ''; + for i := 1 to Length(Expression) do + begin + achar := Expression[i]; + if (achar = '<') or (achar = '>') or (achar = '=') or (achar = '+') or (achar = '-') + then + begin + pos := i; + chr := chr + achar; + // check for second character + achar := Expression[i+1]; + if (achar = '=') or (achar = '<') or (achar = '>') then + chr := chr + achar; + OpLong := Length(chr); + break; + end; + end; + Result := pos; +end; + +procedure TSelectIfFrm.RemoveBlanks(var Expression: string); +var + stlength, i : integer; + tempstr : string; + +begin + tempstr := ''; + stlength := Length(Expression); + for i := 1 to stlength do + begin + if Expression[i] <> ' ' then tempstr := tempstr + Expression[i]; + end; + Expression := tempstr; +end; + +procedure TSelectIfFrm.GetLeftSt(var Expression: string; var LeftSt: string; + FromPos: integer); +VAR i : integer; +begin + LeftSt := ''; + for i := 1 to FromPos - 1 do + if Expression[i] <> ' ' then LeftSt := LeftSt + Expression[i]; +end; + +procedure TSelectIfFrm.GetRightSt(var Expression: string; var RightSt: string; + FromPos: integer; OpLong: integer); + VAR i : integer; +begin + RightSt := ''; + for i := FromPos + OpLong to Length(Expression) do + begin + RightSt := RightSt + Expression[i]; + end; +end; + +function TSelectIfFrm.isnumeric(var Expression: string): integer; +var + valid : boolean; + i : integer; + +begin + valid := false; + for i := 1 to Length(Expression) do + begin + if ( (Expression[i] >= '0') and (Expression[i] <= '9') ) or + (Expression[i] = '.') or (Expression[i] = '-') or + (Expression[i] = '+') or (Expression[i] = ',') then valid := true + else begin + valid := false; + break; + end; + end; + if valid = true then Result := 1 else Result := 0; +end; + +function TSelectIfFrm.GetVarIndex(var varstring: string; + var VarLabels: StrDyneVec; NoVars: integer): integer; +var + i, varno : integer; + tempstr : string; + +begin + // find a match, if any, between varstring and a VarLabel. Return the + // sequence number of the matching VarLabel if found, else -1. + varno := -1; + for i := 1 to NoVars do + begin + tempstr := VarLabels[i-1]; + RemoveBlanks(tempstr); + if varstring = tempstr then + begin + varno := i; + break; + end; + end; + Result := varno; +end; + +procedure TSelectIfFrm.BuildIfList(var Expression: string; + var ExprList: StrDyneVec; var NoExpr: integer; var JoinOps: StrDyneVec); +var + stlength, LeftCnt, RightCnt, LeftParen, RightParen, i : integer; + SubExpr : string; + done, found : boolean; + delpos : integer; + +begin + //This routine parses a compound expression into a list of sub-expressions + // and joining logical operations + done := false; + NoExpr := 0; + RemoveBlanks(Expression); + stlength := Length(Expression); + if stlength = 0 then exit; + CheckParens(LeftCnt, RightCnt, Expression); + if LeftCnt <> RightCnt then + begin + ShowMessage('ERROR! Unmatched parentheses'); + ResetBtnClick(self); + exit; + end; + while not done do + begin + SubExpr := ''; + GetExpression(Expression, SubExpr, LeftParen, RightParen); + if LeftParen < RightParen then + begin + TrimParens(SubExpr); + LeftCnt := LeftCnt - 1; + RightCnt := RightCnt - 1; + end; + stlength := Length(SubExpr); + if stlength = 0 then + begin + ShowMessage('Warning! Empty expression found (extraneous parentheses)'); + ResetBtnClick(self); + exit; + end; + NoExpr := NoExpr + 1; + ExprList[NoExpr-1] := SubExpr; + if LeftCnt > 0 then // more than one set of parentheses + begin + // Look for a logical connection to next subexpression, if any + found := false; + delpos := RightParen; + if RightParen > 0 then + begin + for i := RightParen+1 to Length(Expression) do + begin + if Expression[i] = '(' then break // start of expression + else begin + if (Expression[i] = '|') or (Expression[i] = '&') or (Expression[i] = '!') then + begin + JoinOps[NoExpr-1] := JoinOps[NoExpr-1] + Expression[i]; + found := true; + delpos := i; + end; + end; // end if Expession[i] = '(' + end; // next i + end; // if RightParen > 0 + + if found = false then JoinOps[NoExpr-1] := ' ' + else JoinOps[NoExpr-1] := Trim(JoinOps[NoExpr-1]); + if RightParen = 1 then //whole expression left + begin + Expression := ''; // make empty + done := true; + end; + //delete both the substring and the adjacent operator + if done = false then + begin + if found = true then// join operation was found + RightParen := delpos; + DelSubSt(Expression, LeftParen, RightParen); + end; + if (LeftCnt = 1) then // single expression left + begin + TrimParens(Expression); + LeftCnt := LeftCnt - 1; + RightCnt := RightCnt - 1; + end; + + if Length(Expression) = 0 then done := true; + end // end if LeftCnt > 0 + else done := true; + end; // end while not done +end; + +procedure TSelectIfFrm.parse(var Expression: string; var ExprList: StrDyneVec; + var NoExpr: integer; var Ops: StrDyneVec; var LeftValue: StrDyneVec; + var RightValue: StrDyneVec; var JoinOps: StrDyneVec); +var + OpPos, i, OpLong : integer; + tempstr: String; + tempstr2: string = ''; + chr: string = ''; + +begin + // An Expression string should contain one or more parenthetical substrings. + // Each substring should contain an arithmetic or logical operation and have + // a variable or numeric value to the left and right of the operand. The + // substrings should have a logical operand between them (&, |, or !). + // The parse routine first obtains a list of subexpressions and their + // logical seperators (operands). It then parses each subexpression and + // builds a list of operations, left values and right values. + BuildIfList(Expression, ExprList, NoExpr, JoinOps); + for i := 1 to NoExpr do + begin + tempstr := ExprList[i-1]; + OpPos := OpPosition(tempstr, chr, OpLong); + if (OpPos = -1) then + begin + ShowMessage('ERROR! Expression missing an operator'); + exit; + end; + Ops[i-1] := Ops[i-1] + chr; + tempstr := ExprList[i-1]; + GetLeftSt(tempstr, tempstr2, OpPos); + LeftValue[i-1] := tempstr2; + tempstr := ExprList[i-1]; + GetRightSt(tempstr,tempstr2, OpPos, OpLong); + RightValue[i-1] := tempstr2; + end; +end; + +function TSelectIfFrm.TruthValue(caseno, ExpNo: integer; var LeftStr: string; + var RightStr: string; var OpCode: string; var VarLabels: StrDyneVec; + NoVars: integer): boolean; +var + TempValueLeft, TempValueRight : double; + typeresult, LeftVarPos, RightVarPos : integer; + LeftIsNo, RightIsNo, Truth, badvalue : boolean; + +begin + badvalue := false; + TempValueLeft := 0.0; + TempValueRight := 0.0; + LeftVarPos := 0; + RightVarPos := 0; + + typeresult := isnumeric(LeftStr); + if typeresult = 1 then + begin + TempValueLeft := StrToFloat(LeftStr); + LeftIsNo := true; + end + else begin //check for a variable label + LeftIsNo := false; + LeftVarPos := GetVarIndex(LeftStr, VarLabels, NoVars); + if LeftVarPos = -1 then + begin + ShowMessage('ERROR! Invalid variable label'); + Result := false; + exit; + end; + end; + + typeresult := isnumeric(RightStr); + if typeresult = 1 then + begin + TempValueRight := StrToFloat(RightStr); + RightIsNo := true; + end + else begin //check for a variable label + RightIsNo := false; + RightVarPos := GetVarIndex(LeftStr, VarLabels, NoVars); + if RightVarPos = -1 then + begin + ShowMessage('ERROR! Invalid variable label'); + Result := false; + exit; + end; + end; + + // Now evaluate record truth or falseness + if (RightIsNo) and (not LeftIsNo) then // Left is variable, right is value + begin + if ValidValue(caseno,LeftVarPos) then + TempValueLeft := StrToFloat(OS3MainFrm.DataGrid.Cells[LeftVarPos,caseno]) + else badvalue := true; + end; + if (Not RightIsNo) and (LeftIsNo) then // Left is value, right is variable + begin + if ValidValue(caseno,RightVarPos) then + TempValueRight := StrToFloat(OS3MainFrm.DataGrid.Cells[RightVarPos,caseno]) + else badvalue := true; + end; + if ( Not RightIsNo) and ( Not LeftIsNo) then // Both are variables + begin + if ValidValue(caseno,LeftVarPos) then + TempValueLeft := StrToFloat(OS3MainFrm.DataGrid.Cells[LeftVarPos,caseno]) + else badvalue := true; + if ValidValue(caseno,RightVarPos) then + TempValueRight := StrToFloat(OS3MainFrm.DataGrid.Cells[RightVarPos,caseno]) + else badvalue := true; + end; + + Truth := false; + if OpCode = '=' then + begin + if (TempValueLeft = TempValueRight) then Truth := true; + end; + if OpCode = '<' then + begin + if (TempValueLeft < TempValueRight) then Truth := true; + end; + if OpCode = '>' then + begin + if (TempValueLeft > TempValueRight) then Truth := true; + end; + if OpCode = '>=' then + begin + if (TempValueLeft >= TempValueRight) then Truth := true; + end; + if OpCode = '<=' then + begin + if (TempValueLeft <= TempValueRight) then Truth := true; + end; + if OpCode = '<>' then + begin + if (TempValueLeft <> TempValueRight) then Truth := true; + end; + if badvalue then Truth := false; + Result := Truth; +end; + +initialization + {$I selectifunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/tools/sortcasesunit.lfm b/applications/lazstats/source/forms/tools/sortcasesunit.lfm new file mode 100644 index 000000000..c7afbb365 --- /dev/null +++ b/applications/lazstats/source/forms/tools/sortcasesunit.lfm @@ -0,0 +1,216 @@ +object SortCasesFrm: TSortCasesFrm + Left = 449 + Height = 307 + Top = 275 + Width = 327 + AutoSize = True + Caption = 'Sort Cases' + ClientHeight = 307 + ClientWidth = 327 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 8 + Height = 15 + Top = 8 + Width = 46 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Variables' + ParentColor = False + end + object Label2: TLabel + AnchorSideLeft.Control = VarInBtn + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = SortVarEdit + Left = 210 + Height = 15 + Top = 33 + Width = 43 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Sort On:' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = VarInBtn + AnchorSideBottom.Control = Bevel1 + Left = 8 + Height = 233 + Top = 25 + Width = 158 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Constraints.MinHeight = 200 + ItemHeight = 0 + TabOrder = 0 + end + object SortVarEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = VarOutBtn + AnchorSideBottom.Side = asrBottom + Left = 210 + Height = 23 + Top = 50 + Width = 109 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 12 + TabOrder = 3 + Text = 'SortVarEdit' + end + object OrderGroup: TRadioGroup + AnchorSideLeft.Control = VarInBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = VarList + AnchorSideBottom.Side = asrBottom + Left = 174 + Height = 70 + Top = 188 + Width = 118 + Anchors = [akLeft, akBottom] + AutoFill = True + AutoSize = True + BorderSpacing.Top = 12 + BorderSpacing.Right = 16 + Caption = 'Direction:' + ChildSizing.LeftRightSpacing = 16 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 50 + ClientWidth = 114 + ItemIndex = 0 + Items.Strings = ( + 'Ascending' + 'Descending' + ) + TabOrder = 4 + end + object CancelBtn: TButton + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ComputeBtn + AnchorSideBottom.Control = ComputeBtn + Left = 88 + Height = 25 + Top = 274 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 5 + end + object ComputeBtn: TButton + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ReturnBtn + AnchorSideRight.Control = ReturnBtn + Left = 162 + Height = 25 + Top = 274 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 12 + BorderSpacing.Bottom = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 6 + end + object ReturnBtn: TButton + AnchorSideTop.Control = ComputeBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 250 + Height = 25 + Top = 274 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 16 + BorderSpacing.Bottom = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 7 + end + object VarInBtn: TBitBtn + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarList + Left = 174 + Height = 28 + Top = 25 + Width = 28 + BorderSpacing.Right = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = VarInBtnClick + Spacing = 0 + TabOrder = 1 + end + object VarOutBtn: TBitBtn + AnchorSideLeft.Control = Bevel2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = VarInBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = VarInBtn + AnchorSideRight.Side = asrBottom + Left = 174 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = VarOutBtnClick + Spacing = 0 + TabOrder = 2 + end + object Bevel1: TBevel + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 0 + Height = 8 + Top = 258 + Width = 327 + Anchors = [akLeft, akRight, akBottom] + Shape = bsBottomLine + end + object Bevel2: TBevel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + Left = 153 + Height = 14 + Top = 8 + Width = 21 + Shape = bsSpacer + end +end diff --git a/applications/lazstats/source/forms/tools/sortcasesunit.pas b/applications/lazstats/source/forms/tools/sortcasesunit.pas new file mode 100644 index 000000000..9e3e0dde7 --- /dev/null +++ b/applications/lazstats/source/forms/tools/sortcasesunit.pas @@ -0,0 +1,206 @@ +unit SortCasesUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Buttons, + MainUnit, Globals, DictionaryUnit; + +type + + { TSortCasesFrm } + + TSortCasesFrm = class(TForm) + Bevel1: TBevel; + Bevel2: TBevel; + VarInBtn: TBitBtn; + VarOutBtn: TBitBtn; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + OrderGroup: TRadioGroup; + SortVarEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + VarList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure VarInBtnClick(Sender: TObject); + procedure VarOutBtnClick(Sender: TObject); + private + { private declarations } + FAutoSized: Boolean; + public + { public declarations } + end; + +var + SortCasesFrm: TSortCasesFrm; + +implementation + +uses + Math; + +{ TSortCasesFrm } + +procedure TSortCasesFrm.ComputeBtnClick(Sender: TObject); +label strvals, lastplace; +var + temp : string; + i, j, k : integer; + selcol : integer; +begin + selcol := 0; + for i := 1 to NoVariables do + if OS3MainFrm.DataGrid.Cells[i,0] = SortVarEdit.Text then selcol := i; + if DictionaryFrm.DictGrid.Cells[4,selcol] = 'S' then goto strvals; + if selcol > 0 then + begin + if OrderGroup.ItemIndex = 0 then // sort ascending + begin + for i := 1 to NoCases-1 do + begin + for j := i+1 to NoCases do + begin + if StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[selcol,i])) > StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[selcol,j])) then + begin + for k := 1 to NoVariables do + begin + temp := OS3MainFrm.DataGrid.Cells[k,i]; + OS3MainFrm.DataGrid.Cells[k,i] := OS3MainFrm.DataGrid.Cells[k,j]; + OS3MainFrm.DataGrid.Cells[k,j] := temp; + end; + end; + end; // next j + end; // next i + end // if ascending sort + else begin // descending sort + for i := 1 to NoCases-1 do + begin + for j := i+1 to NoCases do + begin + if StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[selcol,i])) + < StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[selcol,j])) then + begin + for k := 1 to NoVariables do + begin + temp := OS3MainFrm.DataGrid.Cells[k,i]; + OS3MainFrm.DataGrid.Cells[k,i] := OS3MainFrm.DataGrid.Cells[k,j]; + OS3MainFrm.DataGrid.Cells[k,j] := temp; + end; + end; + end; // next j + end; // next i + end; // if descending sort + end; // if selcol > 0 + goto lastplace; +strvals: + if selcol > 0 then + begin + if OrderGroup.ItemIndex = 0 then // sort ascending + begin + for i := 1 to NoCases-1 do + begin + for j := i+1 to NoCases do + begin + if Trim(OS3MainFrm.DataGrid.Cells[selcol,i]) > Trim(OS3MainFrm.DataGrid.Cells[selcol,j]) then + begin + for k := 1 to NoVariables do + begin + temp := OS3MainFrm.DataGrid.Cells[k,i]; + OS3MainFrm.DataGrid.Cells[k,i] := OS3MainFrm.DataGrid.Cells[k,j]; + OS3MainFrm.DataGrid.Cells[k,j] := temp; + end; + end; + end; // next j + end; // next i + end // if ascending sort + else begin // descending sort + for i := 1 to NoCases-1 do + begin + for j := i+1 to NoCases do + begin + if Trim(OS3MainFrm.DataGrid.Cells[selcol,i]) + < Trim(OS3MainFrm.DataGrid.Cells[selcol,j]) then + begin + for k := 1 to NoVariables do + begin + temp := OS3MainFrm.DataGrid.Cells[k,i]; + OS3MainFrm.DataGrid.Cells[k,i] := OS3MainFrm.DataGrid.Cells[k,j]; + OS3MainFrm.DataGrid.Cells[k,j] := temp; + end; + end; + end; // next j + end; // next i + end; // if descending sort + end; // if selcol > 0 +lastplace: + end; + +procedure TSortCasesFrm.FormActivate(Sender: TObject); +var + w: Integer; +begin + if FAutoSized then + exit; + + w := MaxValue([CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + CancelBtn.Constraints.MinWidth := w; + ComputeBtn.Constraints.MinWidth := w; + ReturnBtn.Constraints.MinWidth := w; + + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TSortCasesFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <>nil); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TSortCasesFrm.FormShow(Sender: TObject); +VAR i : integer; +begin + SortVarEdit.Text := ''; + VarOutBtn.Enabled := false; + VarInBtn.Enabled := true; + VarList.Items.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TSortCasesFrm.VarInBtnClick(Sender: TObject); +var i : integer; +begin + i := VarList.ItemIndex; + if i < 0 then exit; + SortVarEdit.Text := VarList.Items.Strings[i]; + VarList.Items.Delete(i); + VarInBtn.Enabled := false; + VarOutBtn.Enabled := true; +end; + +procedure TSortCasesFrm.VarOutBtnClick(Sender: TObject); +begin + if SortVarEdit.Text = '' then exit; + VarList.Items.Add(SortVarEdit.Text); + SortVarEdit.Text := ''; + VarOutBtn.Enabled := false; + VarInBtn.Enabled := true; +end; + +initialization + {$I sortcasesunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/variables/equationunit.lfm b/applications/lazstats/source/forms/variables/equationunit.lfm new file mode 100644 index 000000000..d6e3e7238 --- /dev/null +++ b/applications/lazstats/source/forms/variables/equationunit.lfm @@ -0,0 +1,316 @@ +object EquationForm: TEquationForm + Left = 377 + Height = 364 + Top = 142 + Width = 592 + AutoSize = True + BorderStyle = bsSingle + Caption = 'Equation Editor' + ClientHeight = 364 + ClientWidth = 592 + OnCreate = FormCreate + OnShow = ResetBtnClick + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Panel1: TPanel + AnchorSideTop.Control = Bevel1 + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 36 + Top = 320 + Width = 576 + Align = alBottom + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ChildSizing.EnlargeHorizontal = crsHomogenousSpaceResize + ChildSizing.ShrinkHorizontal = crsHomogenousSpaceResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 36 + ClientWidth = 576 + TabOrder = 1 + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = CancelBtn + Left = 299 + Height = 25 + Top = 0 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 0 + end + object CancelBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ComputeBtn + Left = 361 + Height = 25 + Top = 0 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 1 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ReturnBnt + Left = 431 + Height = 25 + Top = 0 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 2 + end + object ReturnBnt: TButton + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 515 + Height = 25 + Top = 0 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBntClick + TabOrder = 3 + end + end + object Panel2: TPanel + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Memo1 + AnchorSideTop.Side = asrBottom + Left = 45 + Height = 112 + Top = 189 + Width = 503 + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 112 + ClientWidth = 503 + TabOrder = 0 + object Label1: TLabel + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = OpsCombo + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 15 + Top = 31 + Width = 106 + BorderSpacing.Top = 8 + Caption = 'New Variable Name:' + ParentColor = False + end + object NewVarEdit: TEdit + AnchorSideLeft.Control = Panel2 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 23 + Top = 48 + Width = 127 + BorderSpacing.Top = 2 + TabOrder = 3 + Text = 'NewVarEdit' + end + object Label2: TLabel + AnchorSideLeft.Control = NewVarEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NewVarEdit + AnchorSideTop.Side = asrCenter + Left = 137 + Height = 15 + Top = 52 + Width = 8 + BorderSpacing.Left = 10 + Caption = '=' + ParentColor = False + end + object OpEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NewVarEdit + Left = 155 + Height = 23 + Top = 48 + Width = 96 + BorderSpacing.Left = 10 + TabOrder = 4 + Text = 'OpEdit' + end + object FuncEdit: TEdit + AnchorSideLeft.Control = OpEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NewVarEdit + Left = 259 + Height = 23 + Top = 48 + Width = 136 + BorderSpacing.Left = 8 + TabOrder = 5 + Text = 'FuncEdit' + end + object VarEdit: TEdit + AnchorSideLeft.Control = FuncEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NewVarEdit + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 403 + Height = 23 + Top = 48 + Width = 100 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + TabOrder = 6 + Text = 'VarEdit' + end + object OpsCombo: TComboBox + AnchorSideLeft.Control = OpEdit + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = OpEdit + AnchorSideRight.Side = asrBottom + Left = 155 + Height = 23 + Top = 0 + Width = 96 + Anchors = [akTop, akLeft, akRight] + AutoDropDown = True + ItemHeight = 15 + Items.Strings = ( + '+' + '-' + '*' + '/' + '' + ) + OnClick = OpsComboClick + OnSelect = OpsComboSelect + TabOrder = 0 + end + object FunctionCombo: TComboBox + AnchorSideLeft.Control = OpsCombo + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = FuncEdit + AnchorSideRight.Side = asrBottom + Left = 259 + Height = 23 + Top = 0 + Width = 136 + Anchors = [akTop, akLeft, akRight] + AutoDropDown = True + BorderSpacing.Left = 8 + ItemHeight = 15 + Items.Strings = ( + 'sqr' + 'sqrt' + 'sin' + 'cos' + 'tan' + 'asin' + 'acos' + 'atan' + 'log10' + 'ln' + 'exp' + '1 / X' + '' + ) + OnClick = FunctionComboClick + OnSelect = FunctionComboSelect + TabOrder = 1 + end + object VarCombo: TComboBox + AnchorSideLeft.Control = FunctionCombo + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel2 + AnchorSideRight.Control = Panel2 + AnchorSideRight.Side = asrBottom + Left = 403 + Height = 23 + Top = 0 + Width = 100 + Anchors = [akTop, akLeft, akRight] + AutoDropDown = True + BorderSpacing.Left = 8 + ItemHeight = 15 + OnClick = VarComboClick + OnSelect = VarComboSelect + TabOrder = 2 + Text = 'VarCombo' + end + object NextBtn: TButton + AnchorSideTop.Control = NewVarEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = OpEdit + AnchorSideRight.Side = asrBottom + Left = 102 + Height = 25 + Top = 87 + Width = 149 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 16 + Caption = 'Continue for next entry' + OnClick = NextBtnClick + TabOrder = 7 + end + object FinishedBtn: TButton + AnchorSideLeft.Control = FuncEdit + AnchorSideTop.Control = NextBtn + Left = 259 + Height = 25 + Top = 87 + Width = 70 + AutoSize = True + Caption = 'Finished' + OnClick = FinishedBtnClick + TabOrder = 8 + end + end + object Bevel1: TBevel + AnchorSideTop.Control = Panel2 + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 3 + Top = 309 + Width = 592 + Anchors = [akTop, akLeft, akRight] + Shape = bsTopLine + end + object Memo1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 165 + Top = 8 + Width = 576 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'You can create a new variable as a combination of other existing variables with this procedure.'#13#10'First, enter the name of the new variable in the area labeled "New Variable".'#13#10'Next, enter up to three values for each entry in your equation by selecting an operation, function or variable from the "drop-down" boxes. You can select:'#13#10'(a) An operation code (+,-,* or /) except for the first one which should be a function or variable name.'#13#10'(b) A function such as sin, cos, sqrt, etc. can be entered first followed by the variable to be acted upon.'#13#10'(c) A variable name from the list of available variables in the drop-down list of variables.'#13#10'(d) For each variable to be entered, click the "Next Entry" button. Following the first entry, an '#13#10' operation code must be the first entry.'#13#10'When done, click the "Finished" button followed by a click of the "Compute button". An image of the completed function will be displayed before the new values are created.' + ParentColor = False + WordWrap = True + end +end diff --git a/applications/lazstats/source/forms/variables/equationunit.pas b/applications/lazstats/source/forms/variables/equationunit.pas new file mode 100644 index 000000000..7094e3936 --- /dev/null +++ b/applications/lazstats/source/forms/variables/equationunit.pas @@ -0,0 +1,302 @@ +unit EquationUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Math, + MainUnit, Globals, OutputUnit, DataProcs, DictionaryUnit; + +type + + { TEquationForm } + + TEquationForm = class(TForm) + Bevel1: TBevel; + FinishedBtn: TButton; + Memo1: TLabel; + NextBtn: TButton; + Panel1: TPanel; + Panel2: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBnt: TButton; + VarCombo: TComboBox; + FunctionCombo: TComboBox; + OpsCombo: TComboBox; + VarEdit: TEdit; + FuncEdit: TEdit; + OpEdit: TEdit; + Label2: TLabel; + NewVarEdit: TEdit; + Label1: TLabel; + procedure CancelBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FinishedBtnClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FunctionComboClick(Sender: TObject); + procedure FunctionComboSelect(Sender: TObject); + procedure NextBtnClick(Sender: TObject); + procedure OpsComboClick(Sender: TObject); + procedure OpsComboSelect(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure ReturnBntClick(Sender: TObject); + procedure VarComboClick(Sender: TObject); + procedure VarComboSelect(Sender: TObject); + private + { private declarations } + operations, functions, variables : StrDyneVec; + NoEntries : integer; + selected : IntDyneVec; + public + { public declarations } + end; + +var + EquationForm: TEquationForm; + +implementation + +{ TEquationForm } + +procedure TEquationForm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + NewVarEdit.Text := ''; + OpEdit.Text := ''; + FuncEdit.Text := ''; + VarEdit.Text := ''; + OpsCombo.Text := 'Operations'; + FunctionCombo.Text := 'Functions'; + VarCombo.Clear; + for i := 1 to NoVariables do + VarCombo.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + VarCombo.Text := 'Variables'; + VarCombo.DropDownCount := NoVariables; + SetLength(operations,NoVariables); + SetLength(functions,NoVariables); + SetLength(variables,NoVariables); + NoEntries := 0; +end; + +procedure TEquationForm.ReturnBntClick(Sender: TObject); +begin + variables := nil; + functions := nil; + operations := nil; +end; + +procedure TEquationForm.VarComboClick(Sender: TObject); +VAR index : integer; +begin + index := VarCombo.ItemIndex; + if index < 0 then exit; + VarEdit.Text := VarCombo.Items.Strings[index]; + VarCombo.ItemIndex := -1; +end; + +procedure TEquationForm.VarComboSelect(Sender: TObject); +VAR index : integer; +begin + index := VarCombo.ItemIndex; + if index < 0 then exit; + VarEdit.Text := VarCombo.Items.Strings[index]; + VarCombo.ItemIndex := -1; +end; + +procedure TEquationForm.NextBtnClick(Sender: TObject); +begin + operations[NoEntries] := OpEdit.Text; + if ((NoEntries > 0) and (operations[NoEntries] = '') )then + begin + ShowMessage('ERROR-No operation selected - enter again!'); + exit; + end; + functions[NoEntries] := FuncEdit.Text; + variables[NoEntries] := VarEdit.Text; + if (variables[NoEntries] = '') then + begin + ShowMessage('ERROR-No variable entered - enter again!'); + exit; + end; + NoEntries := NoEntries + 1; + OpEdit.Text := ''; + FuncEdit.Text := ''; + VarEdit.Text := ''; + OpsCombo.Text := 'Operations'; + FunctionCombo.Text := 'Functions'; + VarCombo.Text := 'Variables'; +end; + +procedure TEquationForm.OpsComboClick(Sender: TObject); +VAR index : integer; +begin + index := OpsCombo.ItemIndex; + if index < 0 then exit; + OpEdit.Text := OpsCombo.Items.Strings[index]; + OpsCombo.ItemIndex := -1; +end; + +procedure TEquationForm.OpsComboSelect(Sender: TObject); +VAR index : integer; +begin + index := OpsCombo.ItemIndex; + if index < 0 then exit; + OpEdit.Text := OpsCombo.Items.Strings[index]; + OpsCombo.ItemIndex := -1; +end; + +procedure TEquationForm.FinishedBtnClick(Sender: TObject); +begin + operations[NoEntries] := OpEdit.Text; + if ((NoEntries > 0) and (operations[NoEntries] = '')) then + begin + ShowMessage('ERROR-No operation selected - enter again!'); + exit; + end; + functions[NoEntries] := FuncEdit.Text; + variables[NoEntries] := VarEdit.Text; + if (variables[NoEntries] = '') then + begin + ShowMessage('ERROR-No variable entered - enter again!'); + exit; + end; + NoEntries := NoEntries + 1; + OpsCombo.Text := 'Operations'; + FunctionCombo.Text := 'Functions'; + VarCombo.Text := 'Variables'; +end; + +procedure TEquationForm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if OutputFrm = nil then + Application.CreateForm(TOutputFrm, OutputFrm); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +procedure TEquationForm.FunctionComboClick(Sender: TObject); +VAR index : integer; +begin + index := FunctionCombo.ItemIndex; + if index < 0 then exit; + FuncEdit.Text := FunctionCombo.Items.Strings[index]; + FunctionCombo.ItemIndex := -1; +end; + +procedure TEquationForm.FunctionComboSelect(Sender: TObject); +VAR index : integer; +begin + index := FunctionCombo.ItemIndex; + if index < 0 then exit; + FuncEdit.Text := FunctionCombo.Items.Strings[index]; + FunctionCombo.ItemIndex := -1; +end; + +procedure TEquationForm.ComputeBtnClick(Sender: TObject); +VAR + cellstring, outline : string; + opsitem, funcsitem, col, newcol, i, j, k : integer; + newvalue, xvalue : double; +begin + // get position of selected variables from the main grid + SetLength(selected,NoEntries); + for i := 1 to NoVariables do + begin + cellstring := Trim(OS3MainFrm.DataGrid.Cells[i,0]); + for j := 0 to NoEntries - 1 do + if (cellstring = variables[j]) then selected[j] := i; + end; + + // create a new variable in the main grid + col := NoVariables + 1; + newcol := col; + DictionaryFrm.NewVar(col); + OS3MainFrm.DataGrid.Cells[col,0] := NewVarEdit.Text; + DictionaryFrm.DictGrid.Cells[1,col] := NewVarEdit.Text; + + // for each subject obtain selected variable values and add to newvalue + for i := 1 to NoCases do // subject loop + begin + newvalue := 0.0; + for j := 0 to NoEntries - 1 do // list loop + begin + col := selected[j]; + xvalue := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); + if (functions[j] <> '') then // do the function + begin + for k := 0 to 11 do // get function number + begin + if (functions[j] = FunctionCombo.Items.Strings[k]) then funcsitem := k; + end; + case (funcsitem) of + 0: xvalue *= xvalue; + 1: xvalue := sqrt(xvalue); + 2: xvalue := sin(xvalue); + 3: xvalue := cos(xvalue); + 4: xvalue := tan(xvalue); + 5: xvalue := arcsin(xvalue); + 6: xvalue := arccos(xvalue); + 7: xvalue := arctan(xvalue); + 8: xvalue := log10(xvalue); + 9: xvalue := ln(xvalue); + 10: xvalue := exp(xvalue); + 11: xvalue := 1.0 / xvalue; + end; + end; // end if function + if (operations[j] = '') then newvalue := newvalue + xvalue + else // find operation + begin + for k := 0 to 3 do + begin + if (operations[j] = OpsCombo.Items.Strings[k]) then opsitem := k; + end; + case (opsitem) of + 0: newvalue += xvalue; + 1: newvalue -= xvalue; + 2: newvalue *= xvalue; + 3: newvalue /= xvalue; + end; + end; // end else + end; // end jth variable + OS3MainFrm.DataGrid.Cells[newcol,i] := floattostr(newvalue); + FormatCell(newcol,i); + end; // next subject + + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Lines.Add('Equation Used for the New Variable'); + OutputFrm.RichEdit.Lines.Add(''); + outline := NewVarEdit.Text; + outline := outline +' = '; + for j := 0 to NoEntries - 1 do + begin + outline := outline + functions[j]; + outline := outline + ' '; + outline := outline + variables[j]; + outline := outline + ' '; + if (j < NoEntries-1) then + begin + outline := outline + operations[j+1]; + outline := outline + ' '; + end; + end; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.ShowModal; +end; + +procedure TEquationForm.CancelBtnClick(Sender: TObject); +begin + variables := nil; + functions := nil; + operations := nil; +end; + +initialization + {$I equationunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/variables/recodeunit.lfm b/applications/lazstats/source/forms/variables/recodeunit.lfm new file mode 100644 index 000000000..ca6f29462 --- /dev/null +++ b/applications/lazstats/source/forms/variables/recodeunit.lfm @@ -0,0 +1,382 @@ +object RecodeFrm: TRecodeFrm + Left = 690 + Height = 315 + Top = 317 + Width = 459 + AutoSize = True + BorderStyle = bsSingle + Caption = 'Variable Value Recoding' + ClientHeight = 315 + ClientWidth = 459 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + Position = poMainFormCenter + LCLVersion = '2.1.0.0' + object Label1: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = varnameedit + AnchorSideTop.Side = asrCenter + Left = 8 + Height = 15 + Top = 12 + Width = 79 + BorderSpacing.Left = 8 + Caption = 'Variable Name:' + ParentColor = False + end + object varnameedit: TEdit + AnchorSideLeft.Control = Label1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Owner + Left = 95 + Height = 23 + Top = 8 + Width = 119 + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + TabOrder = 0 + Text = 'varnameedit' + end + object TargetList: TRadioGroup + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = varnameedit + AnchorSideTop.Side = asrBottom + Left = 8 + Height = 72 + Top = 39 + Width = 160 + AutoFill = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + Caption = 'Recode Into:' + ChildSizing.LeftRightSpacing = 16 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 156 + Items.Strings = ( + 'The Same Column' + 'A New Column' + ) + TabOrder = 1 + end + object GroupBox1: TGroupBox + AnchorSideLeft.Control = TargetList + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = TargetList + AnchorSideBottom.Control = TargetList + AnchorSideBottom.Side = asrBottom + Left = 184 + Height = 72 + Top = 39 + Width = 165 + Anchors = [akTop, akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 16 + Caption = 'New Value:' + ClientHeight = 52 + ClientWidth = 161 + TabOrder = 2 + object ValueBtn: TRadioButton + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = GroupBox1 + Left = 16 + Height = 19 + Top = 6 + Width = 49 + BorderSpacing.Left = 16 + BorderSpacing.Top = 6 + Caption = 'Value' + TabOrder = 0 + end + object BlankBtn: TRadioButton + AnchorSideLeft.Control = GroupBox1 + AnchorSideTop.Control = NewValEdit + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 19 + Top = 27 + Width = 100 + BorderSpacing.Left = 16 + Caption = 'Blank or empty' + TabOrder = 1 + end + object NewValEdit: TEdit + AnchorSideLeft.Control = ValueBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ValueBtn + AnchorSideTop.Side = asrCenter + Left = 73 + Height = 23 + Top = 4 + Width = 80 + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + TabOrder = 2 + Text = 'NewValEdit' + end + end + object GroupBox2: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = TargetList + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = GroupBox1 + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 180 + Top = 119 + Width = 341 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 12 + Caption = 'Old Value:' + ClientHeight = 160 + ClientWidth = 337 + TabOrder = 3 + object Label2: TLabel + AnchorSideLeft.Control = RangeFromEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = RangeBtn + AnchorSideTop.Side = asrCenter + Left = 172 + Height = 15 + Top = 54 + Width = 46 + BorderSpacing.Left = 6 + Caption = 'through ' + ParentColor = False + end + object OldValBtn: TRadioButton + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = GroupBox2 + Left = 16 + Height = 19 + Top = 2 + Width = 52 + BorderSpacing.Left = 16 + BorderSpacing.Top = 2 + Caption = 'Value:' + TabOrder = 0 + end + object OldBlnkBtn: TRadioButton + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = OldValBtn + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 19 + Top = 27 + Width = 54 + BorderSpacing.Left = 16 + BorderSpacing.Top = 6 + Caption = 'Blanks' + TabOrder = 1 + end + object RangeBtn: TRadioButton + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = OldBlnkBtn + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 19 + Top = 52 + Width = 88 + BorderSpacing.Left = 16 + BorderSpacing.Top = 6 + Caption = 'Value Range:' + TabOrder = 2 + end + object LowToBtn: TRadioButton + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = RangeBtn + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 19 + Top = 77 + Width = 141 + BorderSpacing.Left = 16 + BorderSpacing.Top = 6 + Caption = 'Lowest Value through :' + TabOrder = 3 + end + object DownToBtn: TRadioButton + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = LowToBtn + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 19 + Top = 102 + Width = 114 + BorderSpacing.Left = 16 + BorderSpacing.Top = 6 + Caption = 'Highest Down To:' + TabOrder = 4 + end + object AllButBtn: TRadioButton + AnchorSideLeft.Control = GroupBox2 + AnchorSideTop.Control = DownToBtn + AnchorSideTop.Side = asrBottom + Left = 16 + Height = 19 + Top = 127 + Width = 112 + BorderSpacing.Left = 16 + BorderSpacing.Top = 6 + Caption = 'All Values Except:' + TabOrder = 5 + end + object OldValEdit: TEdit + AnchorSideTop.Control = OldValBtn + AnchorSideTop.Side = asrCenter + Left = 0 + Height = 23 + Top = 0 + Width = 87 + TabOrder = 6 + Text = 'OldValEdit' + end + object RangeFromEdit: TEdit + AnchorSideLeft.Control = RangeBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = RangeBtn + AnchorSideTop.Side = asrCenter + Left = 108 + Height = 23 + Top = 50 + Width = 58 + BorderSpacing.Left = 4 + TabOrder = 7 + Text = 'RangeFromEdit' + end + object RangeToEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = RangeBtn + AnchorSideTop.Side = asrCenter + Left = 224 + Height = 23 + Top = 50 + Width = 65 + BorderSpacing.Left = 6 + BorderSpacing.Right = 12 + TabOrder = 8 + Text = 'RangeToEdit' + end + object LowToEdit: TEdit + AnchorSideLeft.Control = LowToBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = LowToBtn + AnchorSideTop.Side = asrCenter + AnchorSideRight.Side = asrBottom + Left = 161 + Height = 23 + Top = 75 + Width = 69 + BorderSpacing.Left = 4 + TabOrder = 9 + Text = 'LowToEdit' + end + object HiDownToEdit: TEdit + AnchorSideLeft.Control = LowToEdit + AnchorSideTop.Control = DownToBtn + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LowToEdit + AnchorSideRight.Side = asrBottom + Left = 161 + Height = 23 + Top = 100 + Width = 69 + Anchors = [akTop, akLeft, akRight] + TabOrder = 10 + Text = 'HiDownToEdit' + end + object AllButEdit: TEdit + AnchorSideLeft.Control = LowToEdit + AnchorSideTop.Control = AllButBtn + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = LowToEdit + AnchorSideRight.Side = asrBottom + Left = 161 + Height = 23 + Top = 125 + Width = 69 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Bottom = 12 + TabOrder = 11 + Text = 'AllButEdit' + end + end + object ResetBtn: TButton + AnchorSideLeft.Control = ReturnBtn + AnchorSideRight.Control = ReturnBtn + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = CancelBtn + Left = 365 + Height = 25 + Top = 163 + Width = 73 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Bottom = 12 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 4 + end + object CancelBtn: TButton + AnchorSideLeft.Control = ReturnBtn + AnchorSideRight.Control = ReturnBtn + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ApplyBtn + Left = 365 + Height = 25 + Top = 200 + Width = 73 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Bottom = 12 + Caption = ' Cancel ' + ModalResult = 2 + TabOrder = 5 + end + object ApplyBtn: TButton + AnchorSideLeft.Control = ReturnBtn + AnchorSideRight.Control = ReturnBtn + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = ReturnBtn + Left = 365 + Height = 25 + Top = 237 + Width = 73 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Bottom = 12 + Caption = 'Apply' + OnClick = ApplyBtnClick + TabOrder = 6 + end + object ReturnBtn: TButton + AnchorSideLeft.Control = GroupBox2 + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Control = CancelBtn + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = GroupBox2 + AnchorSideBottom.Side = asrBottom + Left = 365 + Height = 25 + Top = 274 + Width = 73 + Anchors = [akLeft, akBottom] + AutoSize = True + BorderSpacing.Left = 16 + BorderSpacing.Right = 12 + Caption = ' Return ' + ModalResult = 1 + TabOrder = 7 + end +end diff --git a/applications/lazstats/source/forms/variables/recodeunit.pas b/applications/lazstats/source/forms/variables/recodeunit.pas new file mode 100644 index 000000000..8e75f1e43 --- /dev/null +++ b/applications/lazstats/source/forms/variables/recodeunit.pas @@ -0,0 +1,267 @@ +unit RecodeUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + MainUnit, Globals, DataProcs, DictionaryUnit; + + +type + + { TRecodeFrm } + + TRecodeFrm = class(TForm) + AllButEdit: TEdit; + ResetBtn: TButton; + CancelBtn: TButton; + ApplyBtn: TButton; + ReturnBtn: TButton; + HiDownToEdit: TEdit; + LowToEdit: TEdit; + RangeToEdit: TEdit; + Label2: TLabel; + RangeFromEdit: TEdit; + OldValEdit: TEdit; + GroupBox2: TGroupBox; + NewValEdit: TEdit; + GroupBox1: TGroupBox; + OldValBtn: TRadioButton; + OldBlnkBtn: TRadioButton; + RangeBtn: TRadioButton; + LowToBtn: TRadioButton; + DownToBtn: TRadioButton; + AllButBtn: TRadioButton; + ValueBtn: TRadioButton; + BlankBtn: TRadioButton; + TargetList: TRadioGroup; + varnameedit: TEdit; + Label1: TLabel; + procedure ApplyBtnClick(Sender: TObject); + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + private + { private declarations } + oldcol : integer; + newplace : boolean; + newcol :integer; + public + { public declarations } + end; + +var + RecodeFrm: TRecodeFrm; + +implementation + +{ TRecodeFrm } + +procedure TRecodeFrm.ResetBtnClick(Sender: TObject); +begin + varnameEdit.Text := ''; + NewValEdit.Text := ''; + OldValEdit.Text := ''; + RangeFromEdit.Text := ''; + RangeToEdit.Text := ''; + LowToEdit.Text := ''; + HiDownToEdit.Text := ''; + AllButEdit.Text := ''; + TargetList.ItemIndex := 0; + ValueBtn.Checked := true; + OldValBtn.Checked := true; + oldcol := OS3MainFrm.DataGrid.Col; + varnameEdit.Text := OS3MainFrm.DataGrid.Cells[oldcol,0]; + newplace := false; +end; + +procedure TRecodeFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TRecodeFrm.ApplyBtnClick(Sender: TObject); +label gohere; +var + i, oldchoice, typedata, comparison : integer; + cellstring, oldvalue, newvalue, lowrange, hirange, upto : string; + hidown, allbut : string; + dblX1, dblX2, dblold : double; + +begin + oldchoice := 0; + if newplace = true then + begin + oldcol := newcol; + goto gohere; + end; + + // get target of where the recode will be placed + if TargetList.ItemIndex = 0 then + begin + newcol := oldcol; + newplace := false; + end + else begin + newplace := true; + DictionaryFrm.NewVar(NoVariables+1); + newcol := NoVariables; + cellstring := 'New' + OS3MainFrm.DataGrid.Cells[oldcol,0]; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + DictionaryFrm.DictGrid.Cells[1,newcol] := cellstring; + OS3MainFrm.DataGrid.Cells[newcol,0] := cellstring; + for i := 2 to 7 do + DictionaryFrm.DictGrid.Cells[i,newcol] := DictionaryFrm.DictGrid.Cells[i,oldcol]; + end; +gohere: + // get value to recode to + if ValueBtn.Checked then newvalue := NewValEdit.Text + else newvalue := ''; + + // get type of value and value to be recoded + if OldValBtn.Checked then + begin + oldvalue := Trim(OldValEdit.Text); + oldchoice := 1; + end; + if OldBlnkBtn.Checked then + begin + oldvalue := ''; + oldchoice := 2; + end; + if RangeBtn.Checked then + begin + lowrange := Trim(RangeFromEdit.Text); + hirange := Trim(RangeToEdit.Text); + oldchoice := 3; + end; + if LowToBtn.Checked then + begin + upto := Trim(LowToEdit.Text); + oldchoice := 4; + end; + if DownToBtn.Checked then + begin + hidown := Trim(HiDownToEdit.Text); + oldchoice := 5; + end; + if AllButBtn.Checked then + begin + allbut := Trim(AllButEdit.Text); + oldchoice := 6; + end; + + // Now, do the recoding + for i := 1 to NoCases do + begin + if not ValidValue(i,oldcol) then continue; + cellstring := Trim(OS3MainFrm.DataGrid.Cells[oldcol,i]); + // check for a string value. If true set datatype to string + if IsNumeric(cellstring) = false then typedata := 1 + else typedata := 0; // type is string if 1 else numeric + OS3MainFrm.DataGrid.Cells[newcol,i] := cellstring; + case oldchoice of + 1 : if cellstring = oldvalue then + OS3MainFrm.DataGrid.Cells[newcol,i] := newvalue; + 2 : if cellstring = '' then + OS3MainFrm.DataGrid.Cells[newcol,i] := newvalue; + 3 : begin + if typedata = 0 then // numeric + begin + dblX1 := StrToFloat(lowrange); + dblX2 := StrToFloat(hirange); + dblold := StrToFloat(cellstring); + if (dblold >= dblX1) and (dblold <= dblX2) then + OS3MainFrm.DataGrid.Cells[newcol,i] := newvalue; + end + else begin // string compare + comparison := CompareStr(cellstring,lowrange); + if comparison >= 0 then + begin + comparison := CompareStr(hirange,cellstring); + if comparison <= 0 then + OS3MainFrm.DataGrid.Cells[newcol,i] := newvalue; + end; + end; + end; + 4 : begin + if typedata = 0 then // numeric + begin + dblX1 := StrToFloat(upto); + dblold := StrToFloat(cellstring); + if (dblold <= dblX1) then + OS3MainFrm.DataGrid.Cells[newcol,i] := newvalue; + end + else begin // string compare + if length(upto) = length(cellstring) then + begin + comparison := CompareStr(cellstring,upto); + if comparison <= 0 then + OS3MainFrm.DataGrid.Cells[newcol,i] := newvalue; + end; + end; + end; + 5 : begin + if typedata = 0 then // numeric + begin + dblX1 := StrToFloat(hidown); + dblold := StrToFloat(cellstring); + if (dblold >= dblX1) then + OS3MainFrm.DataGrid.Cells[newcol,i] := newvalue; + end + else begin // string compare + if length(hidown) = length(cellstring) then + begin + comparison := CompareStr(cellstring,hidown); + if comparison >= 0 then + OS3MainFrm.DataGrid.Cells[newcol,i] := newvalue; + end; + end; + end; + 6 : begin + if typedata = 0 then // numeric + begin + dblX1 := StrToFloat(allbut); + dblold := StrToFloat(cellstring); + if (dblold <> dblX1) then + OS3MainFrm.DataGrid.Cells[newcol,i] := newvalue; + end + else begin // string compare + if length(allbut) = length(cellstring) then + begin + comparison := CompareStr(cellstring,allbut); + if comparison <> 0 then + OS3MainFrm.DataGrid.Cells[newcol,i] := newvalue; + end + else OS3MainFrm.DataGrid.Cells[newcol,i] := newvalue; + end; + end; + end; // end case + FormatCell(newcol,i); + end; +end; + +procedure TRecodeFrm.FormActivate(Sender: TObject); +begin + Constraints.MinWidth := Width; + Constraints.MaxWidth := Width; + Constraints.MinHeight := Height; + Constraints.MaxHeight := Height; +end; + +procedure TRecodeFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +initialization + {$I recodeunit.lrs} + +end. + diff --git a/applications/lazstats/source/forms/variables/transfrmunit.lfm b/applications/lazstats/source/forms/variables/transfrmunit.lfm new file mode 100644 index 000000000..7009acd58 --- /dev/null +++ b/applications/lazstats/source/forms/variables/transfrmunit.lfm @@ -0,0 +1,484 @@ +object TransFrm: TTransFrm + Left = 464 + Height = 386 + Top = 126 + Width = 672 + AutoSize = True + Caption = 'Transformations' + ClientHeight = 386 + ClientWidth = 672 + OnActivate = FormActivate + OnCreate = FormCreate + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Panel1: TPanel + Left = 0 + Height = 41 + Top = 345 + Width = 672 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + ClientHeight = 41 + ClientWidth = 672 + TabOrder = 1 + object CancelBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ComputeBtn + Left = 449 + Height = 25 + Top = 8 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 2 + end + object ComputeBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ReturnBtn + Left = 519 + Height = 25 + Top = 8 + Width = 76 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 3 + end + object ReturnBtn: TButton + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 603 + Height = 25 + Top = 8 + Width = 61 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + Caption = 'Return' + ModalResult = 1 + TabOrder = 4 + end + object HelpBtn: TButton + Tag = 150 + AnchorSideTop.Control = Panel1 + AnchorSideRight.Control = ResetBtn + Left = 328 + Height = 25 + Top = 8 + Width = 51 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 12 + BorderSpacing.Top = 8 + BorderSpacing.Right = 8 + BorderSpacing.Bottom = 8 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 0 + end + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = HelpBtn + AnchorSideRight.Control = CancelBtn + AnchorSideBottom.Side = asrBottom + Left = 387 + Height = 25 + Top = 8 + Width = 54 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 1 + end + end + object Bevel1: TBevel + Left = 0 + Height = 8 + Top = 337 + Width = 672 + Align = alBottom + Shape = bsBottomLine + end + object Panel2: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideBottom.Control = Bevel1 + Left = 0 + Height = 337 + Top = 0 + Width = 672 + Align = alClient + BevelOuter = bvNone + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 3 + ClientHeight = 337 + ClientWidth = 672 + Constraints.MinHeight = 300 + TabOrder = 0 + object Panel4: TPanel + Left = 8 + Height = 329 + Top = 8 + Width = 445 + Align = alClient + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Top = 8 + BorderSpacing.Right = 4 + BevelOuter = bvNone + ClientHeight = 329 + ClientWidth = 445 + TabOrder = 0 + object Label2: TLabel + AnchorSideLeft.Control = V1InBtn + AnchorSideLeft.Side = asrBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = V1Edit + Left = 244 + Height = 15 + Top = 33 + Width = 70 + Anchors = [akLeft, akBottom] + BorderSpacing.Left = 8 + BorderSpacing.Bottom = 2 + Caption = 'Argument V1' + ParentColor = False + end + object Label3: TLabel + AnchorSideLeft.Control = Label2 + AnchorSideTop.Control = V1Edit + AnchorSideTop.Side = asrBottom + Left = 244 + Height = 15 + Top = 105 + Width = 48 + BorderSpacing.Top = 32 + Caption = 'Constant' + ParentColor = False + end + object Label4: TLabel + AnchorSideLeft.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideBottom.Control = V2Edit + Left = 244 + Height = 15 + Top = 185 + Width = 70 + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 32 + BorderSpacing.Bottom = 2 + Caption = 'Argument V2' + ParentColor = False + end + object V1InBtn: TBitBtn + AnchorSideLeft.Control = Panel4 + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Label8 + AnchorSideTop.Side = asrBottom + Left = 208 + Height = 28 + Top = 25 + Width = 28 + BorderSpacing.Left = 8 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = V1InBtnClick + Spacing = 0 + TabOrder = 1 + end + object V1OutBtn: TBitBtn + AnchorSideLeft.Control = V1InBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = V1InBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = V1InBtn + AnchorSideRight.Side = asrBottom + Left = 208 + Height = 28 + Top = 57 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = V1OutBtnClick + Spacing = 0 + TabOrder = 2 + end + object V2InBtn: TBitBtn + AnchorSideLeft.Control = V1InBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = ConstantEdit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = V1InBtn + AnchorSideRight.Side = asrBottom + Left = 208 + Height = 28 + Top = 177 + Width = 28 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 32 + Images = MainDataModule.ImageList + ImageIndex = 1 + OnClick = V2InBtnClick + Spacing = 0 + TabOrder = 5 + end + object V2OutBtn: TBitBtn + AnchorSideLeft.Control = V1InBtn + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = V2InBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = V1InBtn + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = V2Edit + AnchorSideBottom.Side = asrBottom + Left = 208 + Height = 28 + Top = 209 + Width = 28 + BorderSpacing.Top = 4 + Images = MainDataModule.ImageList + ImageIndex = 0 + OnClick = V2OutBtnClick + Spacing = 0 + TabOrder = 6 + end + object V1Edit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideTop.Control = Label2 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel4 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = V1OutBtn + AnchorSideBottom.Side = asrBottom + Left = 244 + Height = 23 + Top = 50 + Width = 201 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Bottom = 12 + TabOrder = 3 + Text = 'V1Edit' + end + object ConstantEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideTop.Control = Label3 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = V1Edit + AnchorSideRight.Side = asrBottom + Left = 244 + Height = 23 + Top = 122 + Width = 201 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + TabOrder = 4 + Text = 'ConstantEdit' + end + object V2Edit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideTop.Control = Label4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = V1Edit + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = V2OutBtn + AnchorSideBottom.Side = asrBottom + Left = 244 + Height = 23 + Top = 202 + Width = 201 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 12 + TabOrder = 7 + Text = 'V2Edit' + end + object Label5: TLabel + AnchorSideLeft.Control = Label2 + AnchorSideBottom.Control = SaveEdit + Left = 244 + Height = 15 + Top = 289 + Width = 114 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 2 + Caption = 'Save New Variable As:' + ParentColor = False + end + object SaveEdit: TEdit + AnchorSideLeft.Control = Label2 + AnchorSideRight.Control = V1Edit + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel4 + AnchorSideBottom.Side = asrBottom + Left = 244 + Height = 23 + Top = 306 + Width = 201 + Anchors = [akLeft, akRight, akBottom] + TabOrder = 8 + Text = 'SaveEdit' + end + object Label8: TLabel + Left = 0 + Height = 15 + Top = 8 + Width = 9 + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 2 + Caption = ' ' + ParentColor = False + end + object VarList: TListBox + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = Label1 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = V1InBtn + AnchorSideBottom.Control = Panel4 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 312 + Top = 17 + Width = 200 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + ItemHeight = 0 + TabOrder = 0 + end + object Label1: TLabel + AnchorSideLeft.Control = Panel4 + AnchorSideTop.Control = Panel4 + Left = 0 + Height = 15 + Top = 0 + Width = 46 + Caption = 'Variables' + ParentColor = False + end + end + object Panel5: TPanel + AnchorSideLeft.Control = Panel4 + AnchorSideLeft.Side = asrBottom + Left = 466 + Height = 337 + Top = 0 + Width = 206 + Align = alRight + BorderSpacing.Left = 4 + BevelOuter = bvNone + ClientHeight = 337 + ClientWidth = 206 + TabOrder = 1 + object Label6: TLabel + AnchorSideLeft.Control = Panel5 + AnchorSideBottom.Control = TransEdit + Left = 0 + Height = 15 + Top = 297 + Width = 130 + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 12 + BorderSpacing.Bottom = 2 + Caption = 'Selected Transformation:' + ParentColor = False + end + object TransList: TListBox + AnchorSideLeft.Control = Panel5 + AnchorSideTop.Control = Label7 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel5 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Label6 + Left = 0 + Height = 260 + Top = 25 + Width = 198 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 2 + BorderSpacing.Right = 8 + Items.Strings = ( + 'New = V1 + C' + 'New = V1 - C' + 'New = V1 * C' + 'New = V1 / C' + 'New = V1 ^ C' + 'New = V1 + V2' + 'New = V1 - V2' + 'New = V1 * V2' + 'New = V1 / V2' + 'New = V1 ^ V2' + 'New = ln(V1) {base e}' + 'New = log(V1) {base 10}' + 'New = exp(v1) {base e}' + 'New = exp(V1) {base 10}' + 'New = Sin(V1)' + 'New = Cos(V1)' + 'New = Tan(V1)' + 'New = ArcSin(V1)' + 'New = ArcCos(V1)' + 'New = ArcTan(V1)' + 'New = Z(V1)' + 'New = Rank(V1)' + 'New = ProbZ(V1)' + 'New = NormDistZ(V1)' + 'New = Abs(V1)' + 'New = C' + 'New = C - X' + 'New = C / X' + ) + ItemHeight = 15 + OnClick = TransListClick + TabOrder = 0 + end + object TransEdit: TEdit + AnchorSideLeft.Control = Panel5 + AnchorSideRight.Control = Panel5 + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel5 + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 23 + Top = 314 + Width = 198 + Anchors = [akLeft, akRight, akBottom] + BorderSpacing.Right = 8 + TabOrder = 1 + Text = 'TransEdit' + end + object Label7: TLabel + AnchorSideTop.Control = Panel5 + Left = 22 + Height = 15 + Top = 8 + Width = 9 + BorderSpacing.Top = 8 + Caption = ' ' + ParentColor = False + end + end + object Splitter1: TSplitter + Left = 457 + Height = 337 + Top = 0 + Width = 5 + Align = alRight + ResizeAnchor = akRight + end + end +end diff --git a/applications/lazstats/source/forms/variables/transfrmunit.pas b/applications/lazstats/source/forms/variables/transfrmunit.pas new file mode 100644 index 000000000..12bc9386f --- /dev/null +++ b/applications/lazstats/source/forms/variables/transfrmunit.pas @@ -0,0 +1,349 @@ +unit TransfrmUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, ExtCtrls, Math, + Globals, FunctionsLib, DataProcs, DictionaryUnit, ContextHelpUnit; + +type + + { TTransFrm } + + TTransFrm = class(TForm) + Bevel1: TBevel; + HelpBtn: TButton; + Label7: TLabel; + Label8: TLabel; + Panel1: TPanel; + Panel2: TPanel; + Panel4: TPanel; + Panel5: TPanel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + ConstantEdit: TEdit; + Splitter1: TSplitter; + TransEdit: TEdit; + Label6: TLabel; + SaveEdit: TEdit; + Label5: TLabel; + TransList: TListBox; + V2Edit: TEdit; + Label3: TLabel; + Label4: TLabel; + V1Edit: TEdit; + Label2: TLabel; + V1InBtn: TBitBtn; + V1OutBtn: TBitBtn; + V2InBtn: TBitBtn; + V2OutBtn: TBitBtn; + Label1: TLabel; + VarList: TListBox; + procedure FormActivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure CancelBtnClick(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure TransListClick(Sender: TObject); + procedure V1InBtnClick(Sender: TObject); + procedure V1OutBtnClick(Sender: TObject); + procedure V2InBtnClick(Sender: TObject); + procedure V2OutBtnClick(Sender: TObject); + + private + { private declarations } + FAutoSized: boolean; + + public + { public declarations } + end; + +var + TransFrm: TTransFrm; + +implementation + +uses MainUnit; + +procedure TTransFrm.ResetBtnClick(Sender: TObject); +var i : integer; +begin + VarList.Clear; + V1Edit.Text := ''; + V2Edit.Text := ''; + ConstantEdit.Text := ''; + SaveEdit.Text := ''; + TransEdit.Text := ''; + V1InBtn.Enabled := true; + V2InBtn.Enabled := true; + V1OutBtn.Enabled := false; + V2OutBtn.Enabled := false; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; + +procedure TTransFrm.HelpBtnClick(Sender: TObject); +begin + if ContextHelpForm = nil then + Application.CreateForm(TContextHelpForm, ContextHelpForm); + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +//------------------------------------------------------------------- + +procedure TTransFrm.CancelBtnClick(Sender: TObject); +begin + TransFrm.Close; +end; +//------------------------------------------------------------------- + +procedure TTransFrm.ReturnBtnClick(Sender: TObject); +begin + TransFrm.Close; +end; +//------------------------------------------------------------------- + +procedure TTransFrm.ComputeBtnClick(Sender: TObject); +var + i, TIndex, v1col, v2col, gridcol : integer; + index, pcntile : DblDyneVec; + cellstring : string; + TwoArgs : boolean; + constant, mean, stddev, N, X, Y, Z : double; + +begin + constant := 0.0; + TwoArgs := false; + v1col := 1; + v2col := 2; + Y := 0.0; + Z := 0.0; + mean := 0.0; + stddev := 0.0; + if (TransEdit.Text = '') then + begin + ShowMessage('ERROR! First click on the desired transformation.'); + exit; + end; + if (V1Edit.Text = '') then + begin + ShowMessage('ERROR! First click on a variable to transform.'); + exit; + end; + if (SaveEdit.Text = '') then + begin + ShowMessage('ERROR! Enter a label for the new variable.'); + exit; + end; + + // Check to see if the transformation requires two variables + TIndex := TransList.ItemIndex; + if ((TIndex > 4) and (TIndex < 10)) then + begin + TwoArgs := true; + if (V2Edit.Text = '') then + begin + ShowMessage('Select a variable for the V2 arguement.'); + exit; + end; + end; + + // Find column of variable one and two (if selected) + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if V1Edit.Text = cellstring then v1col := i; + if (TwoArgs) then + begin + if cellstring = v2Edit.Text then v2col := i; + end; + end; + + // Check for a constant + if (ConstantEdit.Text <> '') then + constant := StrToFloat(ConstantEdit.Text); + + // Add new column to grid + gridcol := NoVariables + 1; + DictionaryFrm.NewVar(gridcol); + DictionaryFrm.DictGrid.Cells[1,gridcol] := SaveEdit.Text; + OS3MainFrm.DataGrid.Cells[gridcol,0] := SaveEdit.Text; + cellstring := SaveEdit.Text; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + +// OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 1; + + SetLength(index,NoCases); + SetLength(pcntile, NoCases); + + // Do the appropriate transformation + if (TIndex = 21) then Rank(v1col, index); // get ranks + + if ((TIndex = 22) or (TIndex = 24)) then PRank(v1col, pcntile); // get percentile ranks + + if ((TIndex = 20) or (TIndex = 23)) then // z transformation - need mean and stddev + begin + mean := 0.0; + stddev := 0.0; + for i := 1 to NoCases do + begin + if IsFiltered(i) then continue; + X := StrToFloat(OS3MainFrm.DataGrid.Cells[v1col,i]); + mean := mean + X; + stddev := stddev + (X * X); + end; + N := NoCases; + stddev := stddev - (mean * mean) / N; + stddev := stddev / (N - 1.0); + stddev := sqrt(stddev); + mean := mean / N; + end; + + for i := 1 to NoCases do // cases + begin + if IsFiltered(i) then continue; + cellstring := Trim((OS3MainFrm.DataGrid.Cells[v1col,i])); + if cellstring = '' then continue; + X := StrToFloat(cellstring); + if TwoArgs then Y := StrToFloat(OS3MainFrm.DataGrid.Cells[v2col,i]); + case TIndex of + 0 : Z := X + constant;// V1 + C + 1 : Z := X - constant;// V1 - C + 2 : Z := X * constant;// V1 * C + 3 : Z := X / constant;// V1 / C + 4 : Z := power(X,constant);// v1 ** C + 5 : Z := X + Y;// V1 + V2 + 6 : Z := X - Y;// V1 - V2 + 7 : Z := X * Y;// V1 * V2 + 8 : Z := X / Y;// V1 / V2 + 9 : Z := power(X,Y);// V1 ** V2 + 10: Z := ln(X);// ln(V1) + 11: Z := log10(X);// log(V1) + 12: Z := exp(X);// exp(V1) + 13: Z := power(10.0,X);// exp(V1) base 10 + 14: Z := sin(X);// sin(V1) + 15: Z := cos(X);// cos(V1) + 16: Z := tan(X);// tan(V1) + 17: Z := arcsin(X);// arcsin(V1) + 18: Z := arccos(X);// arccos(V1) + 19: Z := arctan(X);// arctan(V1) + 20: Z := (X - mean) / stddev;// z(V1) + 21: Z := index[i-1];// Rank(V1) + 22: Z := pcntile[i-1] * 100.0;// %ilerank(V1) + 23: // probz(V1) + begin + Y := (X - mean) / stddev; + Z := probz(Y); + end; + 24: // inversez(V1) - convert to %ile ranks first + begin + Y := pcntile[i-1]; // y is %ile rank of X + Z := inversez(Y); + end; + 25: Z := abs(X);// absolute value of V1: (abs(V1) + 26: // New := C + begin + Z := constant; + end; + 27: Z := constant - X;// New := C - V1 + 28: Z := constant / X;// New := C / V1 + end; + OS3MainFrm.DataGrid.Cells[gridcol,i] := FloatToStr(Z); + end; + OS3MainFrm.DataGrid.Cells[gridcol,0] := SaveEdit.Text; + + // cleanup + index := nil; + pcntile := nil; +end; + +procedure TTransFrm.FormActivate(Sender: TObject); +begin + if FAutoSized then + exit; + + Panel4.Constraints.MinWidth := 2 * Panel5.Width; + Constraints.MinWidth := Width; + Constraints.MinHeight := Height; + + FAutoSized := true; +end; + +procedure TTransFrm.FormCreate(Sender: TObject); +begin + Assert(OS3MainFrm <> nil); + if DictionaryFrm = nil then + Application.CreateForm(TDictionaryFrm, DictionaryFrm); +end; + +//------------------------------------------------------------------- +procedure TTransFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +//-------------------------------------------------------------------- +procedure TTransFrm.TransListClick(Sender: TObject); +var + index : integer; +begin + index := TransList.ItemIndex; + TransEdit.Text := TransList.Items.Strings[index]; +end; +//-------------------------------------------------------------------- + +procedure TTransFrm.V1InBtnClick(Sender: TObject); +var + index : integer; +begin + index := VarList.ItemIndex; + V1Edit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + V1OutBtn.Enabled := true; + V1InBtn.Enabled := false; +end; +//-------------------------------------------------------------------- + +procedure TTransFrm.V1OutBtnClick(Sender: TObject); +begin + VarList.Items.Add(V1Edit.Text); + V1Edit.Text := ''; + V1InBtn.Enabled := true; + V1OutBtn.Enabled := false; +end; +//-------------------------------------------------------------------- + +procedure TTransFrm.V2InBtnClick(Sender: TObject); +var + index : integer; +begin + index := VarList.ItemIndex; + V2Edit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + V2OutBtn.Enabled := true; + V2InBtn.Enabled := false; +end; +//-------------------------------------------------------------------- + +procedure TTransFrm.V2OutBtnClick(Sender: TObject); +begin + VarList.Items.Add(V2Edit.Text); + V2Edit.Text := ''; + V2InBtn.Enabled := true; + V2OutBtn.Enabled := false; +end; +//-------------------------------------------------------------------- + +initialization + {$I transfrmunit.lrs} + +end. + diff --git a/applications/lazstats/source/not used by LazStats/abcloglinunit.lfm b/applications/lazstats/source/not used by LazStats/abcloglinunit.lfm new file mode 100644 index 000000000..a81eb567c --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/abcloglinunit.lfm @@ -0,0 +1,574 @@ +object ABCLogLinearFrm: TABCLogLinearFrm + Left = 122 + Height = 434 + Top = 170 + Width = 699 + Caption = 'Log Linear Analysis for AxBxC Classification Table' + ClientHeight = 434 + ClientWidth = 699 + OnShow = FormShow + LCLVersion = '0.9.28.2' + object Label1: TLabel + Left = 343 + Height = 14 + Top = 40 + Width = 64 + Caption = 'No. of Rows:' + ParentColor = False + end + object Label2: TLabel + Left = 464 + Height = 14 + Top = 36 + Width = 62 + Caption = 'No. of Cols.:' + ParentColor = False + end + object Label3: TLabel + Left = 230 + Height = 14 + Top = 71 + Width = 63 + Caption = 'Row Variable' + ParentColor = False + end + object Label4: TLabel + Left = 230 + Height = 14 + Top = 151 + Width = 77 + Caption = 'Column Variable' + ParentColor = False + end + object Label5: TLabel + Left = 231 + Height = 14 + Top = 232 + Width = 63 + Caption = 'Slice Variable' + ParentColor = False + end + object Label6: TLabel + Left = 230 + Height = 14 + Top = 312 + Width = 93 + Caption = 'Frequency Variable' + ParentColor = False + end + object Label7: TLabel + Left = 584 + Height = 14 + Top = 30 + Width = 64 + Caption = 'No. of Slices:' + ParentColor = False + end + object FileFromGrp: TRadioGroup + Left = 6 + Height = 57 + Top = 5 + Width = 176 + AutoFill = True + Caption = 'Enter Data From:' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 39 + ClientWidth = 172 + Items.Strings = ( + 'File Data in the Main Grid' + 'Data Entered on this Form' + ) + OnClick = FileFromGrpClick + TabOrder = 0 + end + object VarList: TListBox + Left = 8 + Height = 309 + Top = 66 + Width = 173 + ItemHeight = 0 + TabOrder = 1 + end + object RowInBtn: TBitBtn + Left = 192 + Height = 28 + Top = 72 + Width = 31 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = RowInBtnClick + TabOrder = 2 + end + object RowOutBtn: TBitBtn + Left = 192 + Height = 28 + Top = 104 + Width = 31 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = RowOutBtnClick + TabOrder = 3 + end + object ColInBtn: TBitBtn + Left = 192 + Height = 28 + Top = 152 + Width = 31 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = ColInBtnClick + TabOrder = 4 + end + object ColOutBtn: TBitBtn + Left = 192 + Height = 28 + Top = 184 + Width = 31 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = ColOutBtnClick + TabOrder = 5 + end + object SliceBtnIn: TBitBtn + Left = 192 + Height = 28 + Top = 232 + Width = 31 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = SliceBtnInClick + TabOrder = 6 + end + object SliceBtnOut: TBitBtn + Left = 191 + Height = 28 + Top = 264 + Width = 31 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = SliceBtnOutClick + TabOrder = 7 + end + object FreqInBtn: TBitBtn + Left = 192 + Height = 28 + Top = 312 + Width = 31 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = FreqInBtnClick + TabOrder = 8 + end + object FreqOutBtn: TBitBtn + Left = 192 + Height = 28 + Top = 344 + Width = 31 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + NumGlyphs = 0 + OnClick = FreqOutBtnClick + TabOrder = 9 + end + object NRowsEdit: TEdit + Left = 409 + Height = 21 + Top = 26 + Width = 43 + OnKeyPress = NRowsEditKeyPress + TabOrder = 10 + Text = 'NRowsEdit' + end + object NColsEdit: TEdit + Left = 528 + Height = 21 + Top = 26 + Width = 47 + OnKeyPress = NColsEditKeyPress + TabOrder = 11 + Text = 'NColsEdit' + end + object Grid: TStringGrid + Left = 343 + Height = 310 + Top = 62 + Width = 346 + ColCount = 2 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goTabs, goSmoothScroll] + RowCount = 2 + TabOrder = 12 + end + object RowVarEdit: TEdit + Left = 230 + Height = 21 + Top = 87 + Width = 107 + TabOrder = 13 + Text = 'RowVarEdit' + end + object ColVarEdit: TEdit + Left = 231 + Height = 21 + Top = 168 + Width = 107 + TabOrder = 14 + Text = 'Edit3' + end + object SliceVarEdit: TEdit + Left = 230 + Height = 21 + Top = 248 + Width = 107 + TabOrder = 15 + Text = 'Edit3' + end + object FreqVarEdit: TEdit + Left = 230 + Height = 21 + Top = 328 + Width = 107 + TabOrder = 16 + Text = 'Edit3' + end + object ResetBtn: TButton + Left = 8 + Height = 27 + Top = 387 + Width = 73 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 17 + end + object CancelBtn: TButton + Left = 109 + Height = 27 + Top = 387 + Width = 73 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 18 + end + object ComputeBtn: TButton + Left = 343 + Height = 27 + Top = 387 + Width = 73 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 19 + end + object ReturnBtn: TButton + Left = 448 + Height = 27 + Top = 387 + Width = 73 + Caption = 'Return' + ModalResult = 1 + TabOrder = 20 + end + object NslicesEdit: TEdit + Left = 647 + Height = 21 + Top = 24 + Width = 39 + OnKeyPress = NslicesEditKeyPress + TabOrder = 21 + Text = 'NslicesEdit' + end + object HelpBtn: TButton + Tag = 101 + Left = 224 + Height = 27 + Top = 387 + Width = 73 + Caption = 'Help' + OnClick = HelpBtnClick + TabOrder = 22 + end +end diff --git a/applications/lazstats/source/not used by LazStats/abcloglinunit.pas b/applications/lazstats/source/not used by LazStats/abcloglinunit.pas new file mode 100644 index 000000000..ffe53a97e --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/abcloglinunit.pas @@ -0,0 +1,995 @@ +unit ABCLogLinUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + ExtCtrls, StdCtrls, Buttons, Grids, Math, OutPutUnit, MainUnit, + FunctionsLib, Globals, DataProcs, contexthelpunit; + +type + + { TABCLogLinearFrm } + + TABCLogLinearFrm = class(TForm) + HelpBtn: TButton; + RowInBtn: TBitBtn; + RowOutBtn: TBitBtn; + ColInBtn: TBitBtn; + ColOutBtn: TBitBtn; + SliceBtnIn: TBitBtn; + SliceBtnOut: TBitBtn; + FreqInBtn: TBitBtn; + FreqOutBtn: TBitBtn; + NslicesEdit: TEdit; + Label7: TLabel; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + NRowsEdit: TEdit; + NColsEdit: TEdit; + RowVarEdit: TEdit; + ColVarEdit: TEdit; + SliceVarEdit: TEdit; + FreqVarEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Grid: TStringGrid; + VarList: TListBox; + FileFromGrp: TRadioGroup; + procedure ColInBtnClick(Sender: TObject); + procedure ColOutBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure FileFromGrpClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure FreqInBtnClick(Sender: TObject); + procedure FreqOutBtnClick(Sender: TObject); + procedure NColsEditKeyPress(Sender: TObject; var Key: char); + procedure NRowsEditKeyPress(Sender: TObject; var Key: char); + procedure NslicesEditKeyPress(Sender: TObject; var Key: char); + procedure ResetBtnClick(Sender: TObject); + procedure HelpBtnClick(Sender: TObject); + procedure RowInBtnClick(Sender: TObject); + procedure RowOutBtnClick(Sender: TObject); + procedure SliceBtnInClick(Sender: TObject); + procedure SliceBtnOutClick(Sender: TObject); + private + { private declarations } + procedure ModelEffect(Nrows,Ncols,Nslices : integer; + VAR Data : DblDyneCube; + VAR RowMarg : DblDyneVec; + VAR ColMarg : DblDyneVec; + VAR SliceMarg : DblDyneVec; + VAR AB : DblDyneMat; + VAR AC : DblDyneMat; + VAR BC : DblDyneMat; + VAR Total : double; + Model : integer); + procedure Iterate(Nrows, Ncols, Nslices : integer; + VAR Data : DblDyneCube; + VAR RowMarg : DblDyneVec; + VAR ColMarg : DblDyneVec; + VAR SliceMarg : DblDyneVec; + VAR Total : double; + VAR Expected : DblDyneCube; + VAR NewRowMarg : DblDyneVec; + VAR NewColMarg : DblDyneVec; + VAR NewSliceMarg : DblDyneVec; + VAR NewTotal : double); + procedure PrintTable(Nrows, Ncols, Nslices : integer; + VAR Data : DblDyneCube; + VAR RowMarg : DblDyneVec; + VAR ColMarg : DblDyneVec; + VAR SliceMarg : DblDyneVec; + Total : double); + procedure PrintLamdas(Nrows,Ncols,Nslices : integer; + Var CellLambdas : DblDyneQuad; + mu : double); + procedure PrintMatrix(VAR X : DblDyneMat; + Nrows, Ncols: integer; + Title : string); + + public + { public declarations } + end; + +var + ABCLogLinearFrm: TABCLogLinearFrm; + +implementation + +{ TABCLogLinearFrm } + +procedure TABCLogLinearFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + Grid.ColCount := 4; + Grid.RowCount := 2; + Grid.Cells[0,0] := 'ROW'; + Grid.Cells[1,0] := 'COL'; + Grid.Cells[2,0] := 'SLICE'; + Grid.Cells[3,0] := 'FREQ.'; + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + RowVarEdit.Text := ''; + ColVarEdit.Text := ''; + SliceVarEdit.Text := ''; + FreqVarEdit.Text := ''; + NRowsEdit.Text := ''; + NColsEdit.Text := ''; + NSlicesEdit.Text := ''; + VarList.Visible := false; + RowInBtn.Visible := false; + RowOutBtn.Visible := false; + ColInBtn.Visible := false; + ColOutBtn.Visible := false; + SliceBtnIn.Visible := false; + SliceBtnOut.Visible := false; + FreqInBtn.Visible := false; + FreqOutBtn.Visible := false; + Label1.Visible := false; + Label2.Visible := false; + Label3.Visible := false; + Label4.Visible := false; + Label5.Visible := false; + Label6.Visible := false; + Label7.Visible := false; + RowVarEdit.Visible := false; + ColVarEdit.Visible := false; + SliceVarEdit.Visible := false; + FreqVarEdit.Visible := false; + NRowsEdit.Visible := false; + NColsEdit.Visible := false; + NSlicesEdit.Visible := false; + Grid.Visible := false; +end; + +procedure TABCLogLinearFrm.HelpBtnClick(Sender: TObject); +begin + ContextHelpForm.HelpMessage((Sender as TButton).tag); +end; + +procedure TABCLogLinearFrm.RowInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + RowVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + RowOutBtn.Visible := true; + RowInBtn.Visible := false; +end; + +procedure TABCLogLinearFrm.RowOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(RowVarEdit.Text); + RowInBtn.Visible := true; + RowOutBtn.Visible := false; + RowVarEdit.Text := ''; +end; + +procedure TABCLogLinearFrm.SliceBtnInClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + SliceVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + SliceBtnOut.Visible := true; + SliceBtnIn.Visible := false; +end; + +procedure TABCLogLinearFrm.SliceBtnOutClick(Sender: TObject); +begin + VarList.Items.Add(SliceVarEdit.Text); + SliceBtnIn.Visible := true; + SliceBtnOut.Visible := false; + FreqVarEdit.Text := ''; +end; + +procedure TABCLogLinearFrm.FileFromGrpClick(Sender: TObject); +begin + if FileFromGrp.ItemIndex = 0 then // file from main form + begin + VarList.Visible := true; + RowInBtn.Visible := true; + RowOutBtn.Visible := false; + ColInBtn.Visible := true; + ColOutBtn.Visible := false; + SliceBtnIn.Visible := true; + SliceBtnOut.Visible := false; + FreqInBtn.Visible := true; + FreqOutBtn.Visible := false; + Label4.Visible := true; + Label5.Visible := true; + Label6.Visible := true; + Label3.Visible := true; + RowVarEdit.Visible := true; + ColVarEdit.Visible := true; + SliceVarEdit.Visible := true; + FreqVarEdit.Visible := true; + Label1.Visible := false; + Label2.Visible := false; + Label7.Visible := false; + NRowsEdit.Visible := false; + NColsEdit.Visible := false; + NSlicesEdit.Visible := false; + Grid.Visible := false; + end; + if FileFromGrp.ItemIndex = 1 then // data from this form + begin + VarList.Visible := false; + RowInBtn.Visible := false; + RowOutBtn.Visible := false; + ColInBtn.Visible := false; + ColOutBtn.Visible := false; + SliceBtnIn.Visible := false; + SliceBtnOut.Visible := false; + FreqInBtn.Visible := false; + FreqOutBtn.Visible := false; + Label4.Visible := false; + Label5.Visible := false; + Label6.Visible := false; + Label3.Visible := false; + RowVarEdit.Visible := false; + ColVarEdit.Visible := false; + SliceVarEdit.Visible := false; + FreqVarEdit.Visible := false; + Label1.Visible := true; + Label2.Visible := true; + Label7.Visible := true; + NRowsEdit.Visible := true; + NColsEdit.Visible := true; + NSlicesEdit.Visible := true; + Grid.Visible := true; + end; +end; + +procedure TABCLogLinearFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TABCLogLinearFrm.FreqInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + FreqVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + FreqOutBtn.Visible := true; + FreqInBtn.Visible := false; +end; + +procedure TABCLogLinearFrm.FreqOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(FreqVarEdit.Text); + FreqInBtn.Visible := true; + FreqOutBtn.Visible := false; + FreqVarEdit.Text := ''; +end; + +procedure TABCLogLinearFrm.NColsEditKeyPress(Sender: TObject; var Key: char); +begin + if ord(Key) = 13 then NslicesEdit.SetFocus; +end; + +procedure TABCLogLinearFrm.NRowsEditKeyPress(Sender: TObject; var Key: char); +begin + if ord(Key) = 13 then NcolsEdit.SetFocus; +end; + +procedure TABCLogLinearFrm.NslicesEditKeyPress(Sender: TObject; var Key: char); +var + i, j, k, row : integer; + Nslices, Ncols, Nrows : integer; +begin + if ord(Key) = 13 then + begin + Nrows := StrToInt(NrowsEdit.Text); + Ncols := StrToInt(NcolsEdit.Text); + Nslices := StrToInt(NslicesEdit.Text); + Grid.RowCount := Nrows * Ncols * Nslices + 1; + row := 1; + for k := 1 to Nslices do + begin + for j := 1 to Ncols do + begin + for i := 1 to Nrows do + begin + Grid.Cells[0,row] := IntToStr(i); + Grid.Cells[1,row] := IntToStr(j); + Grid.Cells[2,row] := IntToStr(k); + row := row + 1; + end; + end; + end; + Grid.SetFocus; + end; +end; + +procedure TABCLogLinearFrm.ColInBtnClick(Sender: TObject); +VAR index : integer; +begin + index := VarList.ItemIndex; + ColVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + ColOutBtn.Visible := true; + ColInBtn.Visible := false; +end; + +procedure TABCLogLinearFrm.ColOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(ColVarEdit.Text); + ColInBtn.Visible := true; + ColOutBtn.Visible := false; + ColVarEdit.Text := ''; +end; + +procedure TABCLogLinearFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, row, col, slice, Nrows, Ncols, Nslices : integer; + Data : DblDyneCube; + AB, AC, BC : DblDyneMat; + RowMarg, ColMarg, SliceMarg : DblDyneVec; + Total : double; + arraysize : integer; + Model : integer; + astr, Title : string; + RowCol, ColCol, SliceCol, Fcol : integer; + GridPos : IntDyneVec; + value : integer; + Fx : double; +begin + Nrows := 0; + Ncols := 0; + Nslices := 0; + Total := 0.0; + + if FileFromGrp.ItemIndex = 0 then // mainfrm input + begin + SetLength(GridPos,4); + for i := 1 to NoVariables do + begin + if RowVarEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then GridPos[0] := i; + if ColVarEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then GridPos[1] := i; + if SliceVarEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then GridPos[2] := i; + if FreqVarEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then GridPos[3] := i; + end; + // get no. of rows, columns and slices + for i := 1 to OS3MainFrm.DataGrid.RowCount - 1 do + begin + value := StrToInt(OS3MainFrm.DataGrid.Cells[GridPos[0],i]); + if value > Nrows then Nrows := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[GridPos[1],i]); + if value > Ncols then Ncols := value; + value := StrToInt(OS3MainFrm.DataGrid.Cells[GridPos[2],i]); + if value > Nslices then Nslices := value; + end; + SetLength(AB,Nrows+1,Ncols+1); + SetLength(AC,Nrows+1,Nslices+1); + SetLength(BC,Ncols+1,Nslices+1); + SetLength(Data,Nrows+1,Ncols+1,Nslices+1); + SetLength(RowMarg,Nrows+1); + SetLength(ColMarg,Ncols+1); + SetLength(SliceMarg,Nslices+1); + + for i := 1 to Nrows do + for j := 1 to Ncols do + AB[i,j] := 0.0; + for i := 1 to Nrows do + for k := 1 to Nslices do + AC[i,k] := 0.0; + for j := 1 to Ncols do + for k := 1 to Nslices do + BC[j,k] := 0.0; + arraysize := Nrows * Ncols * Nslices; + // Get data + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Data[i,j,k] := 0.0; + rowcol := GridPos[0]; + colcol := GridPos[1]; + slicecol := GridPos[2]; + Fcol := GridPos[3]; + for i := 1 to OS3MainFrm.DataGrid.RowCount - 1 do + begin + if Not GoodRecord(i, 4, GridPos) then continue; + row := StrToInt(OS3MainFrm.DataGrid.Cells[rowcol,i]); + col := StrToInt(OS3MainFrm.DataGrid.Cells[colcol,i]); + slice := StrToInt(OS3MainFrm.DataGrid.Cells[slicecol,i]); + Fx := StrToInt(OS3MainFrm.DataGrid.Cells[Fcol,i]); + Data[row,col,slice] := Data[row,col,slice] + Fx; + Total := Total + Fx; + RowMarg[row] := RowMarg[row] + Fx; + ColMarg[col] := ColMarg[col] + Fx; + SliceMarg[slice] := SliceMarg[slice] + Fx; + AB[row,col] := AB[row,col] + Fx; + AC[row,slice] := AC[row,slice] + Fx; + BC[col,slice] := BC[col,slice] + Fx; + end; + GridPos := nil; + end; + + if FileFromGrp.ItemIndex = 1 then // form input + begin + Nrows := StrToInt(NrowsEdit.Text); + Ncols := StrToInt(NcolsEdit.Text); + Nslices := StrToInt(NslicesEdit.Text); + SetLength(AB,Nrows+1,Ncols+1); + SetLength(AC,Nrows+1,Nslices+1); + SetLength(BC,Ncols+1,Nslices+1); + SetLength(Data,Nrows+1,Ncols+1,Nslices+1); + SetLength(RowMarg,Nrows+1); + SetLength(ColMarg,Ncols+1); + SetLength(SliceMarg,Nslices+1); + + for i := 1 to Nrows do + for j := 1 to Ncols do + AB[i,j] := 0.0; + for i := 1 to Nrows do + for k := 1 to Nslices do + AC[i,k] := 0.0; + for j := 1 to Ncols do + for k := 1 to Nslices do + BC[j,k] := 0.0; + arraysize := Nrows * Ncols * Nslices; + + // get data + for i := 1 to arraysize do + begin + row := StrToInt(Grid.Cells[0,i]); + col := StrToInt(Grid.Cells[1,i]); + slice := StrToInt(Grid.Cells[2,i]); + Data[row,col,slice] := StrToInt(Grid.Cells[3,i]); + AB[row,col] := AB[row,col] + Data[row,col,slice]; + AC[row,slice] := AC[row,slice] + Data[row,col,slice]; + BC[col,slice] := BC[col,slice] + Data[row,col,slice]; + Total := Total + Data[row,col,slice]; + RowMarg[row] := RowMarg[row] + Data[row,col,slice]; + ColMarg[col] := ColMarg[col] + Data[row,col,slice]; + SliceMarg[slice] := SliceMarg[slice] + Data[row,col,slice]; + end; + end; + + // print heading of output + OutPutFrm.RichEdit.Clear; + OutPutFrm.RichEdit.Lines.Add('Log-Linear Analysis of a Three Dimension Table'); + OutPutFrm.RichEdit.Lines.Add(''); + + // print observed matrix + astr := 'Observed Frequencies'; + OutPutFrm.RichEdit.Lines.Add(astr); + PrintTable(Nrows,Ncols,Nslices,Data,RowMarg,ColMarg,SliceMarg,Total); + OutPutFrm.RichEdit.Lines.Add(''); + + // Print sub-matrices + Title := 'Sub-matrix AB'; + PrintMatrix(AB,Nrows,Ncols,Title); + Title := 'Sub-matrix AC'; + PrintMatrix(AC,Nrows,Nslices,Title); + Title := 'Sub-matrix BC'; + PrintMatrix(BC,Ncols,Nslices,Title); + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + + + for Model := 1 to 9 do + ModelEffect(Nrows,Ncols,Nslices,Data,RowMarg,ColMarg, + SliceMarg,AB,AC,BC,Total,Model); + SliceMarg := nil; + ColMarg := nil; + RowMarg := nil; + Data := nil; + BC := nil; + AC := nil; + AB := nil; +end; + +procedure TABCLogLinearFrm.ModelEffect(Nrows,Ncols,Nslices : integer; + VAR Data : DblDyneCube; + VAR RowMarg : DblDyneVec; + VAR ColMarg : DblDyneVec; + VAR SliceMarg : DblDyneVec; + VAR AB : DblDyneMat; + VAR AC : DblDyneMat; + VAR BC : DblDyneMat; + VAR Total : double; + Model : integer); +var + i, j, k, l : integer; + CellLambdas : DblDyneQuad; + LogData, Expected : DblDyneCube; + Title, astr : string; + NewRowMarg,NewColMarg,NewSliceMarg : DblDyneVec; + LogRowMarg, LogColMarg, LogSliceMarg : DblDyneVec; + NewTotal : double; + ABLogs, ACLogs, BCLogs : DblDyneMat; + LogTotal, mu, ModelTotal, Ysqr : double; + DF : integer; + +begin + // Get expected values for chosen model + SetLength(Expected,Nrows+1,Ncols+1,Nslices+1); + SetLength(NewRowMarg,Nrows+1); + SetLength(NewColMarg,Ncols+1); + SetLength(NewSliceMarg,Nslices+1); + SetLength(LogRowMarg,Nrows+1); + SetLength(LogColMarg,Ncols+1); + SetLength(LogSliceMarg,Nslices+1); + SetLength(ABLogs,Nrows+1,Ncols+1); + SetLength(ACLogs,Nrows+1,Nslices+1); + SetLength(BCLogs,Ncols+1,Nslices+1); + SetLength(LogData,Nrows+1,Ncols+1,Nslices+1); + SetLength(CellLambdas,Nrows+1,Ncols+1,Nslices+1,8); + + if Model = 1 then // Saturated model + begin + Title := 'Saturated Model'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := Data[i,j,k]; + end; + + if Model = 2 then // independence + begin + Title := 'Model of Independence'; + Iterate(Nrows,Ncols,Nslices,Data,RowMarg,ColMarg,SliceMarg,Total, + Expected,NewRowMarg,NewColMarg,NewSliceMarg,NewTotal); + end; + + if Model = 3 then // no AB effect + begin + Title := 'No AB Effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := AC[i,k] * BC[j,k] / SliceMarg[k]; + end; + if Model = 4 then // no AC effect + begin + Title := 'No AC Effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := AB[i,j] * BC[j,k] / ColMarg[j]; + end; + if Model = 5 then // no BC effect + begin + Title := 'No BC Effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := AB[i,j] * AC[i,k] / RowMarg[i]; + end; + if Model = 6 then // no C effect + begin + Title := 'Model of No Slice (C) effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := (RowMarg[i] / Total) * + (ColMarg[j] / Total) * (Total / Nslices); + end; + + if Model = 7 then // no B effect + begin + Title := 'Model of no Column (B) effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := (RowMarg[i] / Total) * + (SliceMarg[k] / Total) * (Total / Ncols); + end; + + if Model = 8 then // no A effect + begin + Title := 'Model of no Row (A) effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := (ColMarg[j] / Total) * + (SliceMarg[k] / Total) * (Total / Nrows); + end; + + if Model = 9 then // Equiprobability Model + begin + Title := 'Equi-probability Model'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := Total / + (Nrows * NCols * Nslices); + end; + LogTotal := 0.0; + for i := 1 to Nrows do + begin + NewRowMarg[i] := 0.0; + LogRowMarg[i] := 0.0; + end; + for j := 1 to Ncols do + begin + NewColMarg[j] := 0.0; + LogColMarg[j] := 0.0; + end; + for k := 1 to Nslices do + begin + NewSliceMarg[k] := 0.0; + LogSliceMarg[k] := 0.0; + end; + + for i := 1 to Nrows do + for j := 1 to Ncols do + ABLogs[i,j] := 0.0; + + for i := 1 to Nrows do + for k := 1 to Nslices do + ACLogs[i,k] := 0.0; + + for j := 1 to Ncols do + for k := 1 to Nslices do + BCLogs[j,k] := 0.0; + + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + NewRowMarg[i] := NewRowMarg[i] + Expected[i,j,k]; + NewColMarg[j] := NewColMarg[j] + Expected[i,j,k]; + NewSliceMarg[k] := NewSliceMarg[k] + Expected[i,j,k]; + end; + end; + end; + + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + LogData[i,j,k] := ln(Expected[i,j,k]); + + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + LogRowMarg[i] := LogRowMarg[i] + LogData[i,j,k]; + LogColMarg[j] := LogColMarg[j] + LogData[i,j,k]; + LogSliceMarg[k] := LogSliceMarg[k] + LogData[i,j,k]; + ABLogs[i,j] := ABLogs[i,j] + LogData[i,j,k]; + ACLogs[i,k] := ACLogs[i,k] + LogData[i,j,k]; + BCLogs[j,k] := BCLogs[j,k] + LogData[i,j,k]; + LogTotal := LogTotal + LogData[i,j,k]; + end; + end; + end; + + for i := 1 to Nrows do LogRowMarg[i] := LogRowMarg[i] / (Ncols * Nslices); + for j := 1 to Ncols do LogColMarg[j] := LogColMarg[j] / (Nrows * Nslices); + for k := 1 to Nslices do LogSliceMarg[k] := LogSliceMarg[k] / (Ncols * Nrows); + LogTotal := LogTotal / (Ncols * Nrows * Nslices); + for i := 1 to Nrows do + for j := 1 to Ncols do + ABLogs[i,j] := ABLogs[i,j] / Nslices; + for i := 1 to Nrows do + for k := 1 to Nslices do + ACLogs[i,k] := ACLogs[i,k] / Ncols; + for j := 1 to Ncols do + for k := 1 to Nslices do + BCLogs[j,k] := BCLogs[j,k] / Nrows; + + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + CellLambdas[i,j,k,1] := LogRowMarg[i] - LogTotal; + CellLambdas[i,j,k,2] := LogColMarg[j] - LogTotal; + CellLambdas[i,j,k,3] := LogSliceMarg[k] - LogTotal; + CellLambdas[i,j,k,4] := ABLogs[i,j] - LogRowMarg[i] + - LogColMarg[j] + LogTotal; + CellLambdas[i,j,k,5] := ACLogs[i,k] - LogRowMarg[i] + - LogSliceMarg[k] + LogTotal; + CellLambdas[i,j,k,6] := BCLogs[j,k] - LogColMarg[j] + - LogSliceMarg[k] + LogTotal; + CellLambdas[i,j,k,7] := LogData[i,j,k] + LogRowMarg[i] + + LogColMarg[j] + LogSliceMarg[k] + - ABLogs[i,j] - ACLogs[i,k] + - BCLogs[j,k] - LogTotal; + end; + end; + end; + mu := LogTotal; + + // Get Y square for model + Ysqr := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Ysqr := Ysqr + (Data[i,j,k] * ln(Data[i,j,k] / Expected[i,j,k])); + Ysqr := 2.0 * Ysqr; + + OutPutFrm.RichEdit.Lines.Add(Title); + OutPutFrm.RichEdit.Lines.Add(''); + + astr := 'Expected Frequencies'; + OutPutFrm.RichEdit.Lines.Add(astr); + PrintTable(Nrows,Ncols,Nslices,Expected,NewRowMarg,NewColMarg, + NewSliceMarg,NewTotal); + OutPutFrm.RichEdit.Lines.Add(''); + + astr := 'Log Frequencies'; + OutPutFrm.RichEdit.Lines.Add(astr); + PrintTable(Nrows,Ncols,Nslices,LogData,LogRowMarg,LogColMarg,LogSliceMarg,LogTotal); + OutPutFrm.RichEdit.Lines.Add(''); + + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + + astr := 'Cell Parameters'; + OutPutFrm.RichEdit.Lines.Add(astr); + PrintLamdas(Nrows,Ncols,Nslices,CellLambdas, mu); + OutPutFrm.RichEdit.Lines.Add(''); + + astr := 'G squared statistic for model fit = ' + format('%6.3f',[Ysqr]); + case Model of + 1 : DF := 0; // saturated + 2 : DF := Nrows * Ncols * Nslices - Nrows - Ncols - Nslices + 2; // independence + 3 : DF := Nslices * (Nrows - 1) * (Ncols - 1); //no AB effect + 4 : DF := Ncols * (Nrows - 1) * (Nslices - 1); // no AC effect + 5 : DF := Nrows * (Ncols - 1) * (Nslices - 1); // no BC effect + 6 : DF := Nrows * Ncols * Nslices - Nrows - Ncols + 1; // no C effect + 7 : DF := Nrows * Ncols * Nslices - Nrows - Nslices + 1; // no B effect + 8 : DF := Nrows * Ncols * Nslices - Ncols - Nslices + 1; // no A effect + 9 : DF := Nrows * Ncols * Nslices - 1; // Equiprobability + end; + astr := astr + ' D.F. = ' + IntToStr(DF); + OutPutFrm.RichEdit.Lines.Add(astr); + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + CellLambdas := nil; + LogData := nil; + BCLogs := nil; + ACLogs := nil; + ABLogs := nil; + LogSliceMarg := nil; + LogColMarg := nil; + LogRowMarg := nil; + NewSliceMarg := nil; + NewColMarg := nil; + NewRowMarg := nil; + Expected := nil; +end; +//------------------------------------------------------------------- + +procedure TABCLogLinearFrm.Iterate(Nrows, Ncols, Nslices : integer; + VAR Data : DblDyneCube; + VAR RowMarg : DblDyneVec; + VAR ColMarg : DblDyneVec; + VAR SliceMarg : DblDyneVec; + VAR Total : double; + VAR Expected : DblDyneCube; + VAR NewRowMarg : DblDyneVec; + VAR NewColMarg : DblDyneVec; + VAR NewSliceMarg : DblDyneVec; + VAR NewTotal : double); + +Label Step; +var + Aprevious : DblDyneCube; + i, j, k : integer; + delta : double; + difference : double; + +begin + SetLength(Aprevious,Nrows+1,Ncols+1,Nslices+1); + delta := 0.1; + difference := 0.0; + for i := 1 to Nrows do newrowmarg[i] := 0.0; + for j := 1 to Ncols do newcolmarg[j] := 0.0; + for k := 1 to Nslices do newslicemarg[k] := 0.0; + + // initialize expected values + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + expected[i,j,k] := 1.0; + Aprevious[i,j,k] := 1.0; + end; + end; + end; + +Step: + // step 1: initialize new row margins and calculate expected value + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + newrowmarg[i] := newrowmarg[i] + expected[i,j,k]; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + expected[i,j,k] := (RowMarg[i] / newrowmarg[i]) * expected[i,j,k]; + + // step 2: initialize new col margins and calculate expected values + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + newcolmarg[j] := newcolmarg[j] + expected[i,j,k]; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + expected[i,j,k] := (ColMarg[j] / newcolmarg[j]) * expected[i,j,k]; + + // step 3: initialize new slice margins and calculate expected values + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + newslicemarg[k] := newslicemarg[k] + expected[i,j,k]; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + expected[i,j,k] := (SliceMarg[k] / newslicemarg[k]) * expected[i,j,k]; + + // step 4: check for change and quit if smaller than delta + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + if abs(APrevious[i,j,k]-expected[i,j,k]) > difference then + difference := abs(APrevious[i,j,k]-expected[i,j,k]); + + if difference < delta then + begin + newtotal := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + newtotal := newtotal + expected[i,j,k]; + exit; + end + else begin + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + APrevious[i,j,k] := expected[i,j,k]; + for i := 1 to Nrows do newrowmarg[i] := 0.0; + for j := 1 to Ncols do newcolmarg[j] := 0.0; + for k := 1 to Nslices do newslicemarg[k] := 0.0; + difference := 0.0; + goto step; + end; + Aprevious := nil; +end; +//------------------------------------------------------------------- + +procedure TABCLogLinearFrm.PrintTable(Nrows, Ncols, Nslices : integer; + VAR Data : DblDyneCube; + VAR RowMarg : DblDyneVec; + VAR ColMarg : DblDyneVec; + VAR SliceMarg : DblDyneVec; + Total : double); +var + astr : string; + i, j,k : integer; +begin + astr := ' A B C VALUE '; + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + astr := format('%3d %3d %3d %8.3f',[i,j,k,Data[i,j,k]]); + OutPutFrm.RichEdit.Lines.Add(astr); + end; + end; + end; + astr := 'Totals for Dimension A'; + OutPutFrm.RichEdit.Lines.Add(astr); + for i := 1 to Nrows do + begin + astr := format('Row %d %8.3f',[i,RowMarg[i]]); + OutPutFrm.RichEdit.Lines.Add(astr); + end; + astr := 'Totals for Dimension B'; + OutPutFrm.RichEdit.Lines.Add(astr); + for j := 1 to Ncols do + begin + astr := format('Col %d %8.3f',[j,ColMarg[j]]); + OutPutFrm.RichEdit.Lines.Add(astr); + end; + astr := 'Totals for Dimension C'; + OutPutFrm.RichEdit.Lines.Add(astr); + for k := 1 to Nslices do + begin + astr := format('Slice %d %8.3f',[k,SliceMarg[k]]); + OutPutFrm.RichEdit.Lines.Add(astr); + end; +end; +//------------------------------------------------------------------- + +procedure TABCLogLinearFrm.PrintLamdas(Nrows,Ncols,Nslices : integer; + Var CellLambdas : DblDyneQuad; + mu : double); +var + i, j, k, l : integer; + astr : string; +begin + astr := 'ROW COL SLICE MU LAMBDA A LAMBDA B LAMBDA C'; + OutPutFrm.RichEdit.Lines.Add(astr); + astr := ' LAMBDA AB LAMBDA AC LAMBDA BC LAMBDA ABC'; + OutPutFrm.RichEdit.Lines.Add(astr); + OutPutFrm.RichEdit.Lines.Add(''); + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + astr := format('%3d %3d %3d ',[i,j,k]); + astr := astr + format(' %8.3f ',[mu]); + for l := 1 to 3 do + astr := astr + format(' %8.3f ',[CellLambdas[i,j,k,l]]); + OutPutFrm.RichEdit.Lines.Add(astr); + astr := ' '; + for l := 4 to 7 do + astr := astr + format(' %8.3f ',[CellLambdas[i,j,k,l]]); + OutPutFrm.RichEdit.Lines.Add(astr); + OutPutFrm.RichEdit.Lines.Add(''); + end; + end; + end; +end; +//------------------------------------------------------------------- + +procedure TABCLogLinearFrm.PrintMatrix(VAR X : DblDyneMat; + Nrows, Ncols: integer; + Title : string); +Label loop; +var +i, j : integer; +first, last : integer; +astr : string; + +begin + OutPutFrm.RichEdit.Lines.Add(Title); + OutPutFrm.RichEdit.Lines.Add(''); + first := 1; + last := Ncols; + if last > 6 then last := 6; +loop: + astr := 'ROW/COL'; + for j := first to last do astr := astr + format(' %3d ',[j]); + OutPutFrm.RichEdit.Lines.Add(astr); + for i := 1 to Nrows do + begin + astr := format(' %3d ',[i]); + for j := first to last do astr := astr + format(' %8.3f ',[X[i,j]]); + OutPutFrm.RichEdit.Lines.Add(astr); + end; + if last < Ncols then + begin + first := last + 1; + last := Ncols; + if last > 6 then last := 6; + goto loop; + end; + OutPutFrm.RichEdit.Lines.Add(''); +end; + +initialization + {$I abcloglinunit.lrs} + +end. + diff --git a/applications/lazstats/source/not used by LazStats/ajkloglinunit.pas b/applications/lazstats/source/not used by LazStats/ajkloglinunit.pas new file mode 100644 index 000000000..6b3d29c59 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/ajkloglinunit.pas @@ -0,0 +1,981 @@ +unit AJKLogLinUnit; + +interface + +uses + //Windows, Messages, + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Grids, Math, OutPutUnit, Buttons, ExtCtrls, MainUnit, FunctionsUnit, + GlobalDefs, DataProcs; + +type cube = array[1..10,1..10,1..10] of double; +type matrix = array[1..10,1..10] of double; +type vector = array[1..10] of double; +type quad = array[1..10,1..10,1..10,1..7] of double; + +type + TAJKLogLinearFrm = class(TForm) + Memo1: TMemo; + Label1: TLabel; + NrowsEdit: TEdit; + Label2: TLabel; + NcolsEdit: TEdit; + Label3: TLabel; + NslicesEdit: TEdit; + Grid: TStringGrid; + ComputeBtn: TButton; + ExitBtn: TButton; + FileFromGrp: TRadioGroup; + VarList: TListBox; + RowInBtn: TBitBtn; + RowOutBtn: TBitBtn; + Label4: TLabel; + RowVarEdit: TEdit; + ColInBtn: TBitBtn; + ColOutBtn: TBitBtn; + Label5: TLabel; + ColVarEdit: TEdit; + FreqInBtn: TBitBtn; + FreqOutBtn: TBitBtn; + Label6: TLabel; + FreqVarEdit: TEdit; + CancelBtn: TButton; + ResetBtn: TButton; + SliceBtnIn: TBitBtn; + SliceBtnOut: TBitBtn; + Label7: TLabel; + SliceVarEdit: TEdit; + procedure FormShow(Sender: TObject); + procedure ExitBtnClick(Sender: TObject); + procedure NrowsEditKeyPress(Sender: TObject; var Key: Char); + procedure NcolsEditKeyPress(Sender: TObject; var Key: Char); + procedure NslicesEditKeyPress(Sender: TObject; var Key: Char); + procedure ComputeBtnClick(Sender: TObject); + procedure ModelEffect(Nrows,Ncols,Nslices : integer; + VAR Data : cube; + VAR RowMarg : vector; + VAR ColMarg : vector; + VAR SliceMarg : vector; + VAR AB : matrix; + VAR AC : matrix; + VAR BC : matrix; + VAR Total : double; + Model : integer); + procedure Iterate(Nrows, Ncols, Nslices : integer; + VAR Data : cube; + VAR RowMarg : vector; + VAR ColMarg : vector; + VAR SliceMarg : vector; + VAR Total : double; + VAR Expected : cube; + VAR NewRowMarg : vector; + VAR NewColMarg : vector; + VAR NewSliceMarg : vector; + VAR NewTotal : double); + procedure PrintTable(Nrows, Ncols, Nslices : integer; + VAR Data : cube; + VAR RowMarg : vector; + VAR ColMarg : vector; + VAR SliceMarg : vector; + Total : double); + procedure PrintLamdas(Nrows,Ncols,Nslices : integer; + Var CellLambdas : Quad; + mu : double); + procedure PrintMatrix(VAR X : matrix; + Nrows, Ncols: integer; + Title : string); + procedure CancelBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure FileFromGrpClick(Sender: TObject); + procedure RowInBtnClick(Sender: TObject); + procedure RowOutBtnClick(Sender: TObject); + procedure ColInBtnClick(Sender: TObject); + procedure ColOutBtnClick(Sender: TObject); + procedure SliceBtnInClick(Sender: TObject); + procedure SliceBtnOutClick(Sender: TObject); + procedure FreqInBtnClick(Sender: TObject); + procedure FreqOutBtnClick(Sender: TObject); + + private + { Private declarations } + public + { Public declarations } + end; + +var + AJKLogLinearFrm: TAJKLogLinearFrm; + +implementation + +{$R *.DFM} + +procedure TAJKLogLinearFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.ExitBtnClick(Sender: TObject); +begin + Close; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.NrowsEditKeyPress(Sender: TObject; + var Key: Char); +begin + if ord(Key) = 13 then NcolsEdit.SetFocus; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.NcolsEditKeyPress(Sender: TObject; + var Key: Char); +begin + if ord(Key) = 13 then NslicesEdit.SetFocus; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.NslicesEditKeyPress(Sender: TObject; + var Key: Char); +var + i, j, k, row : integer; + Nslices, Ncols, Nrows : integer; +begin + if ord(Key) = 13 then + begin + Nrows := StrToInt(NrowsEdit.Text); + Ncols := StrToInt(NcolsEdit.Text); + Nslices := StrToInt(NslicesEdit.Text); + Grid.RowCount := Nrows * Ncols * Nslices + 1; + row := 1; + for k := 1 to Nslices do + begin + for j := 1 to Ncols do + begin + for i := 1 to Nrows do + begin + Grid.Cells[0,row] := IntToStr(i); + Grid.Cells[1,row] := IntToStr(j); + Grid.Cells[2,row] := IntToStr(k); + row := row + 1; + end; + end; + end; + Grid.SetFocus; + end; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, row, col, slice, Nrows, Ncols, Nslices : integer; + Data : cube; + AB, AC, BC : matrix; + RowMarg, ColMarg, SliceMarg : vector; + Total : double; + arraysize : integer; + Model : integer; + astr, Title : string; + RowCol, ColCol, SliceCol, Fcol : integer; + GridPos : IntDyneVec; + value : integer; + Fx : double; + +begin + Nrows := 0; + Ncols := 0; + Nslices := 0; + Total := 0.0; + + if FileFromGrp.ItemIndex = 0 then // mainfrm input + begin + SetLength(GridPos,4); + for i := 1 to NoVariables do + begin + if RowVarEdit.Text = MainFrm.Grid.Cells[i,0] then GridPos[0] := i; + if ColVarEdit.Text = MainFrm.Grid.Cells[i,0] then GridPos[1] := i; + if SliceVarEdit.Text = MainFrm.Grid.Cells[i,0] then GridPos[2] := i; + if FreqVarEdit.Text = MainFrm.Grid.Cells[i,0] then GridPos[3] := i; + end; + // get no. of rows, columns and slices + for i := 1 to MainFrm.Grid.RowCount - 1 do + begin + value := StrToInt(MainFrm.Grid.Cells[GridPos[0],i]); + if value > Nrows then Nrows := value; + value := StrToInt(MainFrm.Grid.Cells[GridPos[1],i]); + if value > Ncols then Ncols := value; + value := StrToInt(MainFrm.Grid.Cells[GridPos[2],i]); + if value > Nslices then Nslices := value; + end; + for i := 1 to Nrows do + for j := 1 to Ncols do + AB[i,j] := 0.0; + for i := 1 to Nrows do + for k := 1 to Nslices do + AC[i,k] := 0.0; + for j := 1 to Ncols do + for k := 1 to Nslices do + BC[j,k] := 0.0; + arraysize := Nrows * Ncols * Nslices; + // Get data + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Data[i,j,k] := 0.0; + rowcol := GridPos[0]; + colcol := GridPos[1]; + slicecol := GridPos[2]; + Fcol := GridPos[3]; + for i := 1 to MainFrm.Grid.RowCount - 1 do + begin + if Not GoodRecord(i, 4, GridPos) then continue; + row := StrToInt(MainFrm.Grid.Cells[rowcol,i]); + col := StrToInt(MainFrm.Grid.Cells[colcol,i]); + slice := StrToInt(MainFrm.Grid.Cells[slicecol,i]); + Fx := StrToInt(MainFrm.Grid.Cells[Fcol,i]); + Data[row,col,slice] := Data[row,col,slice] + Fx; + Total := Total + Fx; + RowMarg[row] := RowMarg[row] + Fx; + ColMarg[col] := ColMarg[col] + Fx; + SliceMarg[slice] := SliceMarg[slice] + Fx; + AB[row,col] := AB[row,col] + Fx; + AC[row,slice] := AC[row,slice] + Fx; + BC[col,slice] := BC[col,slice] + Fx; + end; + GridPos := nil; + end; + + if FileFromGrp.ItemIndex = 1 then // form input + begin + Nrows := StrToInt(NrowsEdit.Text); + Ncols := StrToInt(NcolsEdit.Text); + Nslices := StrToInt(NslicesEdit.Text); + for i := 1 to Nrows do + for j := 1 to Ncols do + AB[i,j] := 0.0; + for i := 1 to Nrows do + for k := 1 to Nslices do + AC[i,k] := 0.0; + for j := 1 to Ncols do + for k := 1 to Nslices do + BC[j,k] := 0.0; + arraysize := Nrows * Ncols * Nslices; + + // get data + for i := 1 to arraysize do + begin + row := StrToInt(Grid.Cells[0,i]); + col := StrToInt(Grid.Cells[1,i]); + slice := StrToInt(Grid.Cells[2,i]); + Data[row,col,slice] := StrToInt(Grid.Cells[3,i]); + AB[row,col] := AB[row,col] + Data[row,col,slice]; + AC[row,slice] := AC[row,slice] + Data[row,col,slice]; + BC[col,slice] := BC[col,slice] + Data[row,col,slice]; + Total := Total + Data[row,col,slice]; + RowMarg[row] := RowMarg[row] + Data[row,col,slice]; + ColMarg[col] := ColMarg[col] + Data[row,col,slice]; + SliceMarg[slice] := SliceMarg[slice] + Data[row,col,slice]; + end; + end; + + // print heading of output + OutPutFrm.RichEdit.Clear; + OutPutFrm.RichEdit.Lines.Add('Log-Linear Analysis of a Three Dimension Table'); + OutPutFrm.RichEdit.Lines.Add(''); + + // print observed matrix + astr := 'Observed Frequencies'; + OutPutFrm.RichEdit.Lines.Add(astr); + PrintTable(Nrows,Ncols,Nslices,Data,RowMarg,ColMarg,SliceMarg,Total); + OutPutFrm.RichEdit.Lines.Add(''); + + // Print sub-matrices + Title := 'Sub-matrix AB'; + PrintMatrix(AB,Nrows,Ncols,Title); + Title := 'Sub-matrix AC'; + PrintMatrix(AC,Nrows,Nslices,Title); + Title := 'Sub-matrix BC'; + PrintMatrix(BC,Ncols,Nslices,Title); + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + + + for Model := 1 to 9 do + ModelEffect(Nrows,Ncols,Nslices,Data,RowMarg,ColMarg, + SliceMarg,AB,AC,BC,Total,Model); + + +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.ModelEffect(Nrows,Ncols,Nslices : integer; + VAR Data : cube; + VAR RowMarg : vector; + VAR ColMarg : vector; + VAR SliceMarg : vector; + VAR AB : matrix; + VAR AC : matrix; + VAR BC : matrix; + VAR Total : double; + Model : integer); +var + i, j, k, l : integer; + CellLambdas : Quad; + LogData, Expected : cube; + Title, astr : string; + NewRowMarg,NewColMarg,NewSliceMarg : vector; + LogRowMarg, LogColMarg, LogSliceMarg : vector; + NewTotal : double; + ABLogs, ACLogs, BCLogs : matrix; + LogTotal, mu, ModelTotal, Ysqr : double; + DF : integer; + +begin + // Get expected values for chosen model + if Model = 1 then // Saturated model + begin + Title := 'Saturated Model'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := Data[i,j,k]; + end; + + if Model = 2 then // independence + begin + Title := 'Model of Independence'; + Iterate(Nrows,Ncols,Nslices,Data,RowMarg,ColMarg,SliceMarg,Total, + Expected,NewRowMarg,NewColMarg,NewSliceMarg,NewTotal); + end; + + if Model = 3 then // no AB effect + begin + Title := 'No AB Effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := AC[i,k] * BC[j,k] / SliceMarg[k]; + end; + if Model = 4 then // no AC effect + begin + Title := 'No AC Effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := AB[i,j] * BC[j,k] / ColMarg[j]; + end; + if Model = 5 then // no BC effect + begin + Title := 'No BC Effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := AB[i,j] * AC[i,k] / RowMarg[i]; + end; + if Model = 6 then // no C effect + begin + Title := 'Model of No Slice (C) effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := (RowMarg[i] / Total) * + (ColMarg[j] / Total) * (Total / Nslices); + end; + + if Model = 7 then // no B effect + begin + Title := 'Model of no Column (B) effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := (RowMarg[i] / Total) * + (SliceMarg[k] / Total) * (Total / Ncols); + end; + + if Model = 8 then // no A effect + begin + Title := 'Model of no Row (A) effect'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := (ColMarg[j] / Total) * + (SliceMarg[k] / Total) * (Total / Nrows); + end; + + if Model = 9 then // Equiprobability Model + begin + Title := 'Equi-probability Model'; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Expected[i,j,k] := Total / + (Nrows * NCols * Nslices); + end; + LogTotal := 0.0; + for i := 1 to Nrows do + begin + NewRowMarg[i] := 0.0; + LogRowMarg[i] := 0.0; + end; + for j := 1 to Ncols do + begin + NewColMarg[j] := 0.0; + LogColMarg[j] := 0.0; + end; + for k := 1 to Nslices do + begin + NewSliceMarg[k] := 0.0; + LogSliceMarg[k] := 0.0; + end; + + for i := 1 to Nrows do + for j := 1 to Ncols do + ABLogs[i,j] := 0.0; + + for i := 1 to Nrows do + for k := 1 to Nslices do + ACLogs[i,k] := 0.0; + + for j := 1 to Ncols do + for k := 1 to Nslices do + BCLogs[j,k] := 0.0; + + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + NewRowMarg[i] := NewRowMarg[i] + Expected[i,j,k]; + NewColMarg[j] := NewColMarg[j] + Expected[i,j,k]; + NewSliceMarg[k] := NewSliceMarg[k] + Expected[i,j,k]; + end; + end; + end; + + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + LogData[i,j,k] := ln(Expected[i,j,k]); + + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + LogRowMarg[i] := LogRowMarg[i] + LogData[i,j,k]; + LogColMarg[j] := LogColMarg[j] + LogData[i,j,k]; + LogSliceMarg[k] := LogSliceMarg[k] + LogData[i,j,k]; + ABLogs[i,j] := ABLogs[i,j] + LogData[i,j,k]; + ACLogs[i,k] := ACLogs[i,k] + LogData[i,j,k]; + BCLogs[j,k] := BCLogs[j,k] + LogData[i,j,k]; + LogTotal := LogTotal + LogData[i,j,k]; + end; + end; + end; + + for i := 1 to Nrows do LogRowMarg[i] := LogRowMarg[i] / (Ncols * Nslices); + for j := 1 to Ncols do LogColMarg[j] := LogColMarg[j] / (Nrows * Nslices); + for k := 1 to Nslices do LogSliceMarg[k] := LogSliceMarg[k] / (Ncols * Nrows); + LogTotal := LogTotal / (Ncols * Nrows * Nslices); + for i := 1 to Nrows do + for j := 1 to Ncols do + ABLogs[i,j] := ABLogs[i,j] / Nslices; + for i := 1 to Nrows do + for k := 1 to Nslices do + ACLogs[i,k] := ACLogs[i,k] / Ncols; + for j := 1 to Ncols do + for k := 1 to Nslices do + BCLogs[j,k] := BCLogs[j,k] / Nrows; + + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + CellLambdas[i,j,k,1] := LogRowMarg[i] - LogTotal; + CellLambdas[i,j,k,2] := LogColMarg[j] - LogTotal; + CellLambdas[i,j,k,3] := LogSliceMarg[k] - LogTotal; + CellLambdas[i,j,k,4] := ABLogs[i,j] - LogRowMarg[i] + - LogColMarg[j] + LogTotal; + CellLambdas[i,j,k,5] := ACLogs[i,k] - LogRowMarg[i] + - LogSliceMarg[k] + LogTotal; + CellLambdas[i,j,k,6] := BCLogs[j,k] - LogColMarg[j] + - LogSliceMarg[k] + LogTotal; + CellLambdas[i,j,k,7] := LogData[i,j,k] + LogRowMarg[i] + + LogColMarg[j] + LogSliceMarg[k] + - ABLogs[i,j] - ACLogs[i,k] + - BCLogs[j,k] - LogTotal; + end; + end; + end; + mu := LogTotal; + + // Get Y square for model + Ysqr := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Ysqr := Ysqr + (Data[i,j,k] * ln(Data[i,j,k] / Expected[i,j,k])); + Ysqr := 2.0 * Ysqr; + + OutPutFrm.RichEdit.Lines.Add(Title); + OutPutFrm.RichEdit.Lines.Add(''); + + astr := 'Expected Frequencies'; + OutPutFrm.RichEdit.Lines.Add(astr); + PrintTable(Nrows,Ncols,Nslices,Expected,NewRowMarg,NewColMarg, + NewSliceMarg,NewTotal); + OutPutFrm.RichEdit.Lines.Add(''); + + astr := 'Log Frequencies'; + OutPutFrm.RichEdit.Lines.Add(astr); + PrintTable(Nrows,Ncols,Nslices,LogData,LogRowMarg,LogColMarg,LogSliceMarg,LogTotal); + OutPutFrm.RichEdit.Lines.Add(''); + + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + + astr := 'Cell Parameters'; + OutPutFrm.RichEdit.Lines.Add(astr); + PrintLamdas(Nrows,Ncols,Nslices,CellLambdas, mu); + OutPutFrm.RichEdit.Lines.Add(''); + + astr := 'G squared statistic for model fit = ' + format('%6.3f',[Ysqr]); + case Model of + 1 : DF := 0; // saturated + 2 : DF := Nrows * Ncols * Nslices - Nrows - Ncols - Nslices + 2; // independence + 3 : DF := Nslices * (Nrows - 1) * (Ncols - 1); //no AB effect + 4 : DF := Ncols * (Nrows - 1) * (Nslices - 1); // no AC effect + 5 : DF := Nrows * (Ncols - 1) * (Nslices - 1); // no BC effect + 6 : DF := Nrows * Ncols * Nslices - Nrows - Ncols + 1; // no C effect + 7 : DF := Nrows * Ncols * Nslices - Nrows - Nslices + 1; // no B effect + 8 : DF := Nrows * Ncols * Nslices - Ncols - Nslices + 1; // no A effect + 9 : DF := Nrows * Ncols * Nslices - 1; // Equiprobability + end; + astr := astr + ' D.F. = ' + IntToStr(DF); + OutPutFrm.RichEdit.Lines.Add(astr); + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.Iterate(Nrows, Ncols, Nslices : integer; + VAR Data : cube; + VAR RowMarg : vector; + VAR ColMarg : vector; + VAR SliceMarg : vector; + VAR Total : double; + VAR Expected : cube; + VAR NewRowMarg : vector; + VAR NewColMarg : vector; + VAR NewSliceMarg : vector; + VAR NewTotal : double); + +Label Step; +var + previous : cube; + i, j, k : integer; + delta : double; + difference : double; + +begin + delta := 0.1; + difference := 0.0; + for i := 1 to Nrows do newrowmarg[i] := 0.0; + for j := 1 to Ncols do newcolmarg[j] := 0.0; + for k := 1 to Nslices do newslicemarg[k] := 0.0; + + // initialize expected values + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + expected[i,j,k] := 1.0; + previous[i,j,k] := 1.0; + end; + end; + end; + +Step: + // step 1: initialize new row margins and calculate expected value + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + newrowmarg[i] := newrowmarg[i] + expected[i,j,k]; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + expected[i,j,k] := (RowMarg[i] / newrowmarg[i]) * expected[i,j,k]; + + // step 2: initialize new col margins and calculate expected values + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + newcolmarg[j] := newcolmarg[j] + expected[i,j,k]; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + expected[i,j,k] := (ColMarg[j] / newcolmarg[j]) * expected[i,j,k]; + + // step 3: initialize new slice margins and calculate expected values + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + newslicemarg[k] := newslicemarg[k] + expected[i,j,k]; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + expected[i,j,k] := (SliceMarg[k] / newslicemarg[k]) * expected[i,j,k]; + + // step 4: check for change and quit if smaller than delta + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + if abs(Previous[i,j,k]-expected[i,j,k]) > difference then + difference := abs(Previous[i,j,k]-expected[i,j,k]); + + if difference < delta then + begin + newtotal := 0.0; + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + newtotal := newtotal + expected[i,j,k]; + exit; + end + else begin + for i := 1 to Nrows do + for j := 1 to Ncols do + for k := 1 to Nslices do + Previous[i,j,k] := expected[i,j,k]; + for i := 1 to Nrows do newrowmarg[i] := 0.0; + for j := 1 to Ncols do newcolmarg[j] := 0.0; + for k := 1 to Nslices do newslicemarg[k] := 0.0; + difference := 0.0; + goto step; + end; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.PrintTable(Nrows, Ncols, Nslices : integer; + VAR Data : cube; + VAR RowMarg : vector; + VAR ColMarg : vector; + VAR SliceMarg : vector; + Total : double); +var + astr : string; + i, j,k : integer; +begin + astr := ' A B C VALUE '; + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + astr := format('%3d %3d %3d %8.3f',[i,j,k,Data[i,j,k]]); + OutPutFrm.RichEdit.Lines.Add(astr); + end; + end; + end; + astr := 'Totals for Dimension A'; + OutPutFrm.RichEdit.Lines.Add(astr); + for i := 1 to Nrows do + begin + astr := format('Row %d %8.3f',[i,RowMarg[i]]); + OutPutFrm.RichEdit.Lines.Add(astr); + end; + astr := 'Totals for Dimension B'; + OutPutFrm.RichEdit.Lines.Add(astr); + for j := 1 to Ncols do + begin + astr := format('Col %d %8.3f',[j,ColMarg[j]]); + OutPutFrm.RichEdit.Lines.Add(astr); + end; + astr := 'Totals for Dimension C'; + OutPutFrm.RichEdit.Lines.Add(astr); + for k := 1 to Nslices do + begin + astr := format('Slice %d %8.3f',[k,SliceMarg[k]]); + OutPutFrm.RichEdit.Lines.Add(astr); + end; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.PrintLamdas(Nrows,Ncols,Nslices : integer; + Var CellLambdas : Quad; + mu : double); +var + i, j, k, l : integer; + astr : string; +begin + astr := 'ROW COL SLICE MU LAMBDA A LAMBDA B LAMBDA C'; + OutPutFrm.RichEdit.Lines.Add(astr); + astr := ' LAMBDA AB LAMBDA AC LAMBDA BC LAMBDA ABC'; + OutPutFrm.RichEdit.Lines.Add(astr); + OutPutFrm.RichEdit.Lines.Add(''); + for i := 1 to Nrows do + begin + for j := 1 to Ncols do + begin + for k := 1 to Nslices do + begin + astr := format('%3d %3d %3d ',[i,j,k]); + astr := astr + format(' %8.3f ',[mu]); + for l := 1 to 3 do + astr := astr + format(' %8.3f ',[CellLambdas[i,j,k,l]]); + OutPutFrm.RichEdit.Lines.Add(astr); + astr := ' '; + for l := 4 to 7 do + astr := astr + format(' %8.3f ',[CellLambdas[i,j,k,l]]); + OutPutFrm.RichEdit.Lines.Add(astr); + OutPutFrm.RichEdit.Lines.Add(''); + end; + end; + end; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.PrintMatrix(VAR X : matrix; + Nrows, Ncols: integer; + Title : string); +Label loop; +var +i, j : integer; +first, last : integer; +astr : string; + +begin + OutPutFrm.RichEdit.Lines.Add(Title); + OutPutFrm.RichEdit.Lines.Add(''); + first := 1; + last := Ncols; + if last > 6 then last := 6; +loop: + astr := 'ROW/COL'; + for j := first to last do astr := astr + format(' %3d ',[j]); + OutPutFrm.RichEdit.Lines.Add(astr); + for i := 1 to Nrows do + begin + astr := format(' %3d ',[i]); + for j := first to last do astr := astr + format(' %8.3f ',[X[i,j]]); + OutPutFrm.RichEdit.Lines.Add(astr); + end; + if last < Ncols then + begin + first := last + 1; + last := Ncols; + if last > 6 then last := 6; + goto loop; + end; + OutPutFrm.RichEdit.Lines.Add(''); +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.CancelBtnClick(Sender: TObject); +begin + AJKLogLinearFrm.Hide; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.ResetBtnClick(Sender: TObject); +var + i, j : integer; +begin +// for i := 0 to Grid.RowCount - 1 do +// for j := 0 to Grid.ColCount - 1 do +// Grid.Cells[j,i] := ''; + Grid.ColCount := 4; + Grid.RowCount := 2; + Grid.Cells[0,0] := 'ROW'; + Grid.Cells[1,0] := 'COL'; + Grid.Cells[2,0] := 'SLICE'; + Grid.Cells[3,0] := 'FREQ.'; + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(MainFrm.Grid.Cells[i,0]); + RowVarEdit.Text := ''; + ColVarEdit.Text := ''; + FreqVarEdit.Text := ''; + NRowsEdit.Text := ''; + NColsEdit.Text := ''; + NSlicesEdit.Text := ''; + VarList.Visible := false; + RowInBtn.Visible := false; + RowOutBtn.Visible := false; + ColInBtn.Visible := false; + ColOutBtn.Visible := false; + FreqInBtn.Visible := false; + FreqOutBtn.Visible := false; + Label4.Visible := false; + Label5.Visible := false; + Label6.Visible := false; + Label7.Visible := false; + RowVarEdit.Visible := false; + ColVarEdit.Visible := false; + SliceVarEdit.Visible := false; + FreqVarEdit.Visible := false; + Memo1.Visible := false; + Label1.Visible := false; + Label2.Visible := false; + Label3.Visible := false; + NRowsEdit.Visible := false; + NColsEdit.Visible := false; + NSlicesEdit.Visible := false; + Grid.Visible := false; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.FileFromGrpClick(Sender: TObject); +begin + if FileFromGrp.ItemIndex = 0 then // file from main form + begin + VarList.Visible := true; + RowInBtn.Visible := true; + RowOutBtn.Visible := false; + ColInBtn.Visible := true; + ColOutBtn.Visible := false; + SliceBtnIn.Visible := true; + SliceBtnOut.Visible := false; + FreqInBtn.Visible := true; + FreqOutBtn.Visible := false; + Label4.Visible := true; + Label5.Visible := true; + Label6.Visible := true; + Label7.Visible := true; + RowVarEdit.Visible := true; + ColVarEdit.Visible := true; + SliceVarEdit.Visible := true; + FreqVarEdit.Visible := true; + Memo1.Visible := false; + Label1.Visible := false; + Label2.Visible := false; + Label3.Visible := false; + NRowsEdit.Visible := false; + NColsEdit.Visible := false; + NSlicesEdit.Visible := false; + Grid.Visible := false; + end; + if FileFromGrp.ItemIndex = 1 then // data from this form + begin + VarList.Visible := false; + RowInBtn.Visible := false; + RowOutBtn.Visible := false; + ColInBtn.Visible := false; + ColOutBtn.Visible := false; + SliceBtnIn.Visible := false; + SliceBtnOut.Visible := false; + FreqInBtn.Visible := false; + FreqOutBtn.Visible := false; + Label4.Visible := false; + Label5.Visible := false; + Label6.Visible := false; + Label7.Visible := false; + RowVarEdit.Visible := false; + ColVarEdit.Visible := false; + SliceVarEdit.Visible := false; + FreqVarEdit.Visible := false; + Memo1.Visible := true; + Label1.Visible := true; + Label2.Visible := true; + Label3.Visible := true; + NRowsEdit.Visible := true; + NColsEdit.Visible := true; + NSlicesEdit.Visible := true; + Grid.Visible := true; + end; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.RowInBtnClick(Sender: TObject); +var + index : integer; + +begin + index := VarList.ItemIndex; + RowVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + RowOutBtn.Visible := true; + RowInBtn.Visible := false; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.RowOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(RowVarEdit.Text); + RowInBtn.Visible := true; + RowOutBtn.Visible := false; + RowVarEdit.Text := ''; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.ColInBtnClick(Sender: TObject); +var + index : integer; +begin + index := VarList.ItemIndex; + ColVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + ColOutBtn.Visible := true; + ColInBtn.Visible := false; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.ColOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(ColVarEdit.Text); + ColInBtn.Visible := true; + ColOutBtn.Visible := false; + ColVarEdit.Text := ''; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.SliceBtnInClick(Sender: TObject); +var + index : integer; +begin + index := VarList.ItemIndex; + SliceVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + SliceBtnOut.Visible := true; + SliceBtnIn.Visible := false; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.SliceBtnOutClick(Sender: TObject); +begin + VarList.Items.Add(SliceVarEdit.Text); + SliceBtnIn.Visible := true; + SliceBtnOut.Visible := false; + FreqVarEdit.Text := ''; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.FreqInBtnClick(Sender: TObject); +var + index : integer; +begin + index := VarList.ItemIndex; + FreqVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + FreqOutBtn.Visible := true; + FreqInBtn.Visible := false; +end; +//------------------------------------------------------------------- + +procedure TAJKLogLinearFrm.FreqOutBtnClick(Sender: TObject); +begin + VarList.Items.Add(FreqVarEdit.Text); + FreqInBtn.Visible := true; + FreqOutBtn.Visible := false; + FreqVarEdit.Text := ''; +end; +//------------------------------------------------------------------- + +end. diff --git a/applications/lazstats/source/not used by LazStats/anovatests.oas.pas b/applications/lazstats/source/not used by LazStats/anovatests.oas.pas new file mode 100644 index 000000000..6d80aeec8 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/anovatests.oas.pas @@ -0,0 +1,545 @@ +unit ANOVATests.oas; + +{$MODE Delphi} + +Interface + +uses LCLIntf, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + FUNCTIONSLIB, OUTPUTUNIT, GLOBALS; + + +procedure TUKEY(error_ms : double; { mean squared for residual } + error_df : double; { deg. freedom for residual } + value : double; { size of smallest group } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { no. of cases in a group } + min_grp : integer; { minimum group code } + max_grp : integer); { maximum group code } + +procedure SCHEFFETEST(error_ms : double; { mean squared residual } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { count of cases in a group } + min_grp : integer; { code of first group } + max_grp : integer; { code of last group } + total_n : double); { total number of cases } + +procedure Newman_Keuls(error_ms : double; { residual mean squared } + error_df : double; { deg. freedom for error } + value : double; { number in smallest group } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { count of cases in a group } + min_grp : integer; { lowest group code } + max_grp : integer); { largest group code } + +procedure TUKEY_KRAMER(error_ms : double; { residual mean squared } + error_df : double; { deg. freedom for error } + value : double; { number in smallest group } + group_total : DblDyneVec; { sum of scores in group } + group_count : DblDyneVec; { number of caes in group } + min_grp : integer; { code of lowest group } + max_grp : integer); { code of highst group } + +procedure CONTRASTS(error_ms : double; { residual ms } + error_df : double; { residual df } + group_total : DblDyneVec; { group sums } + group_count : DblDyneVec; { group cases } + min_grp : integer; { lowest code } + max_grp : integer; { highest code } + overall_probf : double); { prob of overall test } + +procedure Bonferroni( group_total : DblDyneVec; { sum of scores in group } + group_count : DblDyneVec; { number of caes in group } + group_var : DblDyneVec; { group variances } + min_grp : integer; { code of lowest group } + max_grp : integer); { code of highst group } + +procedure TUKEYBTEST(ErrorMS : double; // within groups error + ErrorDF : double; // degrees of freedom within + group_total : DblDyneVec; // vector of group sums + group_count : DblDyneVec; // vector of group n's + min_grp : integer; // smallest group code + max_grp : integer; // largest group code + groupsize : double); // size of groups (all equal) + +{ --------------------------------------------------------------------- } + +Implementation + +Uses BLKANOVAUNIT; + +procedure TUKEY(error_ms : double; { mean squared for residual } + error_df : double; { deg. freedom for residual } + value : double; { size of smallest group } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { no. of cases in a group } + min_grp : integer; { minimum group code } + max_grp : integer); { maximum group code } +var + sig : boolean; + divisor : double; + df1 : integer; + alpha : double; + contrast, mean1, mean2 : double; + q_stat : double; + i,j : integer; + outline : string; + +begin + alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text); + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); + OutPutFrm.RichEdit.Lines.Add(' Tukey HSD Test for Differences Between Means'); + outline := format(' alpha selected = %4.2f',[alpha]); + OutPutFrm.RichEdit.Lines.Add(outline); + OutPutFrm.RichEdit.Lines.Add('Groups Difference Statistic Probability Significant?'); + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); + divisor := sqrt(error_ms / value ); + for i := min_grp to max_grp - 1 do + for j := i + 1 to max_grp do + begin + outline := format('%2d - %2d ',[i,j]); + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + contrast := mean1 - mean2; + outline := outline + format('%7.3f q = ',[contrast]); + contrast := abs(contrast / divisor) ; + outline := outline + format('%6.3f ',[contrast]); + df1 := max_grp - min_grp + 1; + q_stat := STUDENT(contrast,error_df,df1); + outline := outline + format(' %6.4f',[q_stat]); + if alpha >= q_stat then sig := TRUE else sig := FALSE; + if sig = TRUE then outline := outline + ' YES ' + else outline := outline + ' NO'; + OutPutFrm.RichEdit.Lines.Add(outline); + end; + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); +end; + +{ ------------------------------------------------------------------------ } + +procedure SCHEFFETEST(error_ms : double; { mean squared residual } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { count of cases in a group } + min_grp : integer; { code of first group } + max_grp : integer; { code of last group } + total_n : double); { total number of cases } + +var + statistic, stat_var, stat_sd : double; + mean1, mean2, alpha, difference, prob_scheffe, f_prob, df1, df2 : double; + outline : string; + i, j : integer; +begin + alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------'); + OutPutFrm.RichEdit.Lines.Add(' Scheffe contrasts among pairs of means.'); + outline := format(' alpha selected = %4.2f',[alpha]); + OutPutFrm.RichEdit.Lines.Add(outline); + OutPutFrm.RichEdit.Lines.Add('Group vs Group Difference Scheffe Critical Significant?'); + OutPutFrm.RichEdit.Lines.Add(' Statistic Value'); + OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------'); + alpha := 1.0 - alpha ; + for i:= min_grp to max_grp - 1 do + for j := i + 1 to max_grp do + begin + outline := format('%2d %2d ',[i,j]); + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + difference := mean1 - mean2; + outline := outline + format('%8.2f ',[difference]); + stat_var := error_ms * + ( 1.0 / group_count[i-1] + 1.0 / group_count[j-1]); + stat_sd := sqrt(stat_var); + statistic := abs(difference / stat_sd); + outline := outline + format('%8.2f ',[statistic]); + df1 := max_grp - min_grp; + df2 := total_n - df1 + 1; + f_prob := fpercentpoint(alpha,round(df1),round(df2) ); + prob_scheffe := sqrt(df1 * f_prob); + outline := outline + format('%8.3f ',[prob_scheffe]); + if statistic > prob_scheffe then outline := outline + 'YES' + else outline := outline + 'NO'; + OutPutFrm.RichEdit.Lines.Add(outline); + end; + OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------'); +end; + +{ ----------------------------------------------------------------------- } + +procedure Newman_Keuls(error_ms : double; { residual mean squared } + error_df : double; { deg. freedom for error } + value : double; { number in smallest group } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { count of cases in a group } + min_grp : integer; { lowest group code } + max_grp : integer); { largest group code } +var + i, j : integer; + temp1, temp2 : double; + groupno : IntDyneVec; + alpha : double; + contrast, mean1, mean2 : double; + q_stat : double; + divisor : double; + tempno : integer; + df1 : integer; + sig : boolean; + outline : string; + +begin + SetLength(groupno,max_grp-min_grp+1); + for i := min_grp to max_grp do groupno[i-1] := i; + for i := min_grp to max_grp - 1 do + begin + for j := i + 1 to max_grp do + begin + if group_total[i-1] / group_count[i-1] > + group_total[j-1] / group_count[j-1] then + begin + temp1 := group_total[i-1]; + temp2 := group_count[i-1]; + tempno := groupno[i-1]; + group_total[i-1] := group_total[j-1]; + group_count[i-1] := group_count[j-1]; + groupno[i-1] := groupno[j-1]; + group_total[j-1] := temp1; + group_count[j-1] := temp2; + groupno[j-1] := tempno; + end; + end; + end; + alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------------'); + OutPutFrm.RichEdit.Lines.Add(' Neuman-Keuls Test for Contrasts on Ordered Means'); + outline := format(' alpha selected = %4.2f',[alpha]); + OutPutFrm.RichEdit.Lines.Add(outline); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('Group Mean'); + for i := 1 to max_grp do + begin + outline := format('%3d %10.3f',[groupno[i-1],group_total[i-1] / group_count[i-1]]); + OutPutFrm.RichEdit.Lines.Add(outline); + end; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('Groups Difference Statistic d.f. Probability Significant?'); + OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------------'); + divisor := sqrt(error_ms / value); + for i := min_grp to max_grp - 1 do + begin + for j := i + 1 to max_grp do + begin + outline := format('%2d - %2d ',[groupno[i-1],groupno[j-1]]); + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + contrast := mean1 - mean2; + outline := outline + format('%7.3f q = ',[contrast]); + contrast := abs(contrast / divisor ); + df1 := j - i + 1; + outline := outline + format('%6.3f %2d %3.0f ',[contrast,df1,error_df]); + q_stat := STUDENT(contrast,error_df,df1); + outline := outline + format(' %6.4f',[q_stat]); + if alpha > q_stat then sig := TRUE else sig := FALSE; + if sig = TRUE then outline := outline + ' YES' + else outline := outline + ' NO'; + OutPutFrm.RichEdit.Lines.Add(outline); + end; + end; + OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------------'); + groupno := nil; +end; + +{ ----------------------------------------------------------------------- } + +procedure TUKEY_KRAMER(error_ms : double; { residual mean squared } + error_df : double; { deg. freedom for error } + value : double; { number in smallest group } + group_total : DblDyneVec; { sum of scores in group } + group_count : DblDyneVec; { number of caes in group } + min_grp : integer; { code of lowest group } + max_grp : integer); { code of highst group } +var + sig : boolean; + divisor : double; + df1 : integer; + alpha : double; + contrast, mean1, mean2 : double; + q_stat : double; + outline : string; + i, j : integer; + +begin + alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); + OutPutFrm.RichEdit.Lines.Add(' Tukey-Kramer Test for Differences Between Means'); + outline := format(' alpha selected = %4.2f',[alpha]); + OutPutFrm.RichEdit.Lines.Add(outline); + OutPutFrm.RichEdit.Lines.Add('Groups Difference Statistic Probability Significant?'); + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); + for i := min_grp to max_grp - 1 do + for j := i + 1 to max_grp do + begin + outline := format('%2d - %2d ',[i,j]); + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + contrast := mean1 - mean2; + outline := outline + format('%7.3f q = ',[contrast]); + divisor := sqrt(error_ms * + ( ( 1.0/group_count[i-1] + 1.0/group_count[j-1] ) / 2 ) ); + contrast := abs(contrast / divisor) ; + outline := outline + format('%6.3f ',[contrast]); + df1 := max_grp - min_grp + 1; + q_stat := STUDENT(contrast,error_df,df1); + outline := outline + format(' %6.4f',[q_stat]); + if alpha >= q_stat then sig := TRUE else sig := FALSE; + if sig = TRUE then outline := outline + ' YES ' + else outline := outline + ' NO'; + OutPutFrm.RichEdit.Lines.Add(outline); + end; + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); +end; + +{ ------------------------------------------------------------------------ } + +procedure CONTRASTS(error_ms : double; { residual ms } + error_df : double; { residual df } + group_total : DblDyneVec; { group sums } + group_count : DblDyneVec; { group cases } + min_grp : integer; { lowest code } + max_grp : integer; { highest code } + overall_probf : double); { prob of overall test } +var + nocontrasts, i, j, k : integer; + df1, df2, probstat, statistic, alpha : double; + coefficients : array[1..20,1..20] of double; + nonorthog : boolean; + weight, sumcross : double; + response : string[5]; + outline : string; + prompt : string; + +begin + outline := format('Enter the number of contrasts (less than %2d or 0:',[max_grp-min_grp+1]); + response := InputBox('ORTHOGONAL CONTRASTS',outline,'0'); + nocontrasts := StrToInt(response); + if nocontrasts > 0 then + begin + for i := 1 to nocontrasts do + begin + outline := format('Contrast number %2d',[i]); + for j := 1 to (max_grp - min_grp+1) do + begin + prompt := format('Group %2d coefficient = ',[j]); + response := InputBox(outline,prompt,'1'); + coefficients[i,j] := StrToFloat(response); + end; + end; + { Check for orthogonality } + nonorthog := FALSE; + for i := 1 to nocontrasts - 1 do + begin + for j := i + 1 to nocontrasts do + begin + sumcross := 0; + for k := 1 to (max_grp - min_grp + 1) do + begin + sumcross := sumcross + + coefficients[i,k]*coefficients[j,k]; + end; + if sumcross <> 0 then nonorthog := TRUE; + if sumcross <> 0 then + begin + outline := format('contrasts %2d and %2d not orthogonal.',[i,j]); + ShowMessage('ERROR!' + outline); + end; + end; + end; + if NOT nonorthog then + begin + alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text); + if overall_probf > alpha then + begin + OutPutFrm.RichEdit.Lines.Add('No contrasts significant.'); + exit; + end; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); + OutPutFrm.RichEdit.Lines.Add(' ORTHOGONAL CONTRASTS'); + OutPutFrm.RichEdit.Lines.Add('Contrast Statistic Probability Critical Value Significant?'); + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); + for i := 1 to nocontrasts do + begin + statistic := 0.0; + weight := 0.0; + for j := 1 to (max_grp - min_grp + 1) do + begin + statistic := statistic + (coefficients[i,j] * + (group_total[j-1] / group_count[j-1])); + weight := weight + (sqr(coefficients[i,j]) / + group_count[j-1]); + end; + statistic := sqr(statistic); + statistic := statistic / (error_ms * weight); + outline := format('%3d %9.4f ',[i,statistic]); + df1 := 1; + df2 := error_df; + probstat := probf(statistic,round(df1),round(df2)) / 2; + outline := outline + format('%8.3f %5.2f ',[probstat,alpha]); + if probstat < alpha then outline := outline + 'YES' + else outline := outline + 'NO'; + OutPutFrm.RichEdit.Lines.Add(outline); + end; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('Contrast Coefficients Used:'); + for i := 1 to nocontrasts do + begin + outline := format('Contrast %2d ',[i]); + for j := 1 to (max_grp - min_grp + 1) do + outline := outline + format('%4.1f ',[coefficients[i,j]]); + OutPutFrm.RichEdit.Lines.Add(outline); + end; + end; { if orthogonal } + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); + end; { if nocontrasts > 0 } +end; { of procedure CONTRASTS } +{ ----------------------------------------------------------------------- } + +procedure Bonferroni( group_total : DblDyneVec; { sum of scores in group } + group_count : DblDyneVec; { number of cases in group } + group_var : DblDyneVec; { group variances } + min_grp : integer; { code of lowest group } + max_grp : integer); { code of highst group } +var + i, j : integer; + alpha : double; + contrast, mean1, mean2 : double; + divisor : double; + df2 : integer; + outline : string; + testalpha : double; + NoGrps : integer; + tprob : double; + sig : string[6]; + SS1, SS2 : double; +begin + alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); + OutPutFrm.RichEdit.Lines.Add(' Bonferroni Test for Differences Between Means'); + outline := format(' Overall alpha selected = %4.2f',[alpha]); + OutPutFrm.RichEdit.Lines.Add(outline); + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); + NoGrps := max_grp - min_grp + 1; + testalpha := alpha / ( (NoGrps * (NoGrps-1)) / 2.0 ); + outline := format('Comparisons made at alpha / no. comparisons = %5.3f',[testalpha]); + OutPutFrm.RichEdit.Lines.Add(outline); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('Groups Difference Statistic Prob > Value Significant?'); + for i := 1 to NoGrps - 1 do + begin + for j := i+1 to NoGrps do + begin + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + SS1 := group_var[i-1] * (group_count[i-1] - 1.0); + SS2 := group_var[j-1] * (group_count[j-1] - 1.0); + divisor := (SS1 + SS2) / (group_count[i-1] + group_count[j-1] - 2.0); + divisor := sqrt(divisor * ( 1.0 / group_count[i-1] + 1.0 / group_count[j-1])); + contrast := abs(mean1-mean2) / divisor; + df2 := round(group_count[i-1] + group_count[j-1] - 2.0); + tprob := probt(contrast,df2); + if testalpha >= tprob then sig := 'YES' else sig := 'NO'; + outline := format('%3d - %3d %10.3f %10.3f %10.3f %s', + [min_grp+i-1,min_grp+j-1,mean1-mean2,contrast,tprob,sig]); + OutPutFrm.RichEdit.Lines.Add(outline); + end; + end; +end; +//------------------------------------------------------------------- + +procedure TUKEYBTEST(ErrorMS : double; // within groups error + ErrorDF : double; // degrees of freedom within + group_total : DblDyneVec; // vector of group sums + group_count : DblDyneVec; // vector of group n's + min_grp : integer; // smallest group code + max_grp : integer; // largest group code + groupsize : double); // size of groups (all equal) +var + alpha : double; + outline : string; + i, j : integer; + df1 : double; + qstat : double; + tstat : double; + groupno : IntDyneVec; + temp1, temp2 : double; + tempno : integer; + NoGrps : integer; + contrast : double; + mean1, mean2 : double; + sig : string[6]; + groups : double; + response : string[5]; + divisor : double; + +begin + SetLength(groupno,max_grp-min_grp+1); + alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); + OutPutFrm.RichEdit.Lines.Add(' Tukey B Test for Contrasts on Ordered Means'); + outline := format(' alpha selected = %4.2f',[alpha]); + OutPutFrm.RichEdit.Lines.Add(outline); + OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------'); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('Groups Difference Statistic d.f. Prob.>value Significant?'); + divisor := sqrt(ErrorMS / groupsize); + NoGrps := max_grp - min_grp + 1; + for i := min_grp to max_grp do groupno[i-1] := i; + for i := 1 to NoGrps - 1 do + begin + for j := i + 1 to NoGrps do + begin + if group_total[i-1] / group_count[i-1] > + group_total[j-1] / group_count[j-1] then + begin + temp1 := group_total[i-1]; + temp2 := group_count[i-1]; + tempno := groupno[i-1]; + group_total[i-1] := group_total[j-1]; + group_count[i-1] := group_count[j-1]; + groupno[i-1] := groupno[j-1]; + group_total[j-1] := temp1; + group_count[j-1] := temp2; + groupno[j-1] := tempno; + end; + end; + end; + + for i := 1 to NoGrps-1 do + begin + for j := i+1 to NoGrps do + begin + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + contrast := abs((mean1 - mean2) / divisor); + df1 := j - i + 1.0; + qstat := STUDENT(contrast,ErrorDF,df1); + groups := NoGrps; + tstat := STUDENT(contrast,ErrorDF,groups); + qstat := (qstat + tstat) / 2.0; + if alpha >= qstat then sig := 'YES' else sig := 'NO'; + outline := format('%3d - %3d %10.3f %10.3f %4.0f,%4.0f %5.3f %s', + [groupno[i-1],groupno[j-1], + mean1-mean2,contrast,df1,ErrorDF,qstat,sig]); + OutPutFrm.RichEdit.Lines.Add(outline); + end; + end; + groupno := nil; +end; +//------------------------------------------------------------------- + +end. + + \ No newline at end of file diff --git a/applications/lazstats/source/not used by LazStats/blankunit.lfm b/applications/lazstats/source/not used by LazStats/blankunit.lfm new file mode 100644 index 000000000..3ba2118a3 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/blankunit.lfm @@ -0,0 +1,56 @@ +object BlankFrm: TBlankFrm + Left = 37 + Top = 21 + BorderStyle = bsDialog + Caption = 'Test Item Administration' + ClientHeight = 514 + ClientWidth = 623 + Color = clBtnFace + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Times New Roman' + Font.Style = [] + OnShow = FormShow + PixelsPerInch = 96 + object Label1: TLabel + Left = 8 + Top = 488 + Width = 37 + Height = 14 + Caption = 'Answer:' + end + object Image1: TImage + Left = 0 + Top = 0 + Width = 623 + Height = 449 + Align = alTop + end + object ContinueBtn: TButton + Left = 544 + Top = 480 + Width = 73 + Height = 25 + Caption = 'Continue' + ModalResult = 1 + TabOrder = 0 + OnClick = ContinueBtnClick + end + object AnswerEdit: TEdit + Left = 48 + Top = 480 + Width = 33 + Height = 22 + TabOrder = 1 + end + object AnswerMemo: TMemo + Left = 48 + Top = 456 + Width = 481 + Height = 49 + ScrollBars = ssVertical + TabOrder = 2 + Visible = False + end +end diff --git a/applications/lazstats/source/not used by LazStats/blankunit.pas b/applications/lazstats/source/not used by LazStats/blankunit.pas new file mode 100644 index 000000000..85191ba0e --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/blankunit.pas @@ -0,0 +1,389 @@ +unit BlankUnit; + +{$MODE Delphi} + +interface + +uses + //Windows, Messages, + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, ItemBankGlobals, FunctionsUnit; + +type + TBlankFrm = class(TForm) + ContinueBtn: TButton; + Label1: TLabel; + AnswerEdit: TEdit; + Image1: TImage; + AnswerMemo: TMemo; + procedure ContinueBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + private + { Private declarations } + FontHi, FontWide, Indent, LineWidth, LineHi, PageHi, PageWide : integer; + ImageHi, ImageWide, linecnt : integer; + Grect : TRect; + Bitmap : TBitmap; + R1 : MatchItemsRcd; + R2 : BlankItemRcd; + R3 : MCItemRcd; + R4 : EssayItemRcd; + R5 : TFItemRcd; + public + { Public declarations } + Response : string; + CorrectAnswer : string; + Cont : boolean; + itemtype, itemno, item : integer; + procedure ShowMCItem(Sender : TObject; itemno,item : integer); + procedure ShowTFItem(Sender : TObject; itemno,item : integer); + procedure ShowMAItem(Sender : TObject; itemno,item : integer); + procedure ShowCOItem(Sender : TObject; itemno,item : integer); + procedure ShowESItem(Sender : TObject; itemno,item : integer); + end; + +var + BlankFrm: TBlankFrm; + +implementation + +uses CompTestUnit; + +{$R *.lfm} + +procedure TBlankFrm.ContinueBtnClick(Sender: TObject); +var + i : integer; + +begin + Response := ''; + case itemtype of + 1,2 : Response := AnswerEdit.Text; // MC, TF items + 3,4,5 : begin // MA, CO items + for i := 0 to AnswerMemo.Lines.Count-1 do + Response := Response + AnswerMemo.Lines[i]; + end; + end; + Cont := true; + BlankFrm.Hide; +end; +//------------------------------------------------------------------- +procedure TBlankFrm.ShowMCItem(Sender : TObject; itemno,item : integer); +var + i, j : integer; + S : string; + X, Y : integer; + +begin + ReadMCItem(item, R3); + CorrectAnswer := ''; + for i := 1 to 5 do + begin + if R3.CorWeights[i] > 0.0 then + begin + CorrectAnswer := CorrectAnswer + R3.CorChoices[i] + '*' + FloatToStr(R3.CorWeights[i]); + if i < 5 then CorrectAnswer := CorrectAnswer + ' '; + end; + end; + linecnt := 1; + Y := linecnt * LineHi; + X := indent; + S := format('Item %d (Multiple Choice)',[itemno]); + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + if length(R3.Picture) > 0 then + begin + Grect.Top := linecnt * LineHi; + Grect.Left := indent; + Grect.Right := (3 * ClientWidth div 4) - indent; + Grect.Bottom := Grect.Top + ClientHeight div 3; + BitMap := TBitMap.Create; + if FileExists(R3.Picture) { *Converted from FileExists* } then + begin + Bitmap.LoadFromFile(R3.Picture); + Image1.Canvas.stretchdraw(Grect,Bitmap); + end + else ShowMessage('Image ' + R3.Picture + ' missing.'); + Bitmap.Free; + linecnt := linecnt + (ClientHeight div 3) div LineHi; + linecnt := linecnt + 2; + end; + for j := 1 to 10 do + begin + if length(R3.ItemStem[j]) > 0 then + begin + S := trim(R3.ItemStem[j]); + X := indent; + Y := linecnt * LineHi; + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + end; + end; + for j := 1 to 5 do + begin + if length(R3.Choices[j]) > 0 then + begin + S := chr(j-1 + ord('A')) + ': '; + S := S + R3.Choices[j]; + X := indent + 50; + Y := linecnt * LineHi; + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + end; + end; +end; +//------------------------------------------------------------------- + +procedure TBlankFrm.ShowTFItem(Sender : TObject; itemno,item : integer); +var + j : integer; + S : string; + X, Y : integer; + +begin + ReadTFItem(item,R5); + CorrectAnswer := ''; + CorrectAnswer := CorrectAnswer + R5.CorChoice; + linecnt := 1; + Y := linecnt * LineHi; + X := indent; + S := format('Item %d (True-False)',[itemno]); + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + if length(R5.Picture) > 0 then + begin + Grect.Top := linecnt * LineHi; + Grect.Left := indent; + Grect.Right := (3 * ClientWidth div 4) - indent; + Grect.Bottom := Grect.Top + ClientHeight div 3; + BitMap := TBitMap.Create; + if FileExists(R5.Picture) { *Converted from FileExists* } then + begin + Bitmap.LoadFromFile(R5.Picture); + Image1.Canvas.stretchdraw(Grect,Bitmap); + end + else ShowMessage('Image ' + R5.Picture + ' missing.'); + Bitmap.Free; + linecnt := linecnt + (ClientHeight div 3) div LineHi; + linecnt := linecnt + 2; + end; + for j := 1 to 10 do + begin + if length(R5.ItemStem[j]) > 0 then + begin + S := trim(R5.ItemStem[j]); + X := indent; + Y := linecnt * LineHi; + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + end; + end; + S := chr(ord('A')) + ': '; + S := S + 'TRUE'; + X := indent + 50; + Y := linecnt * LineHi; + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + S := chr(1 + ord('A')) + ': '; + S := S + 'FALSE'; + X := indent + 50; + Y := linecnt * LineHi; + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; +end; +//------------------------------------------------------------------- + +procedure TBlankFrm.ShowMAItem(Sender : TObject; itemno,item : integer); +var + i,j : integer; + S : string; + X, Y : integer; + anscol, itemstartY : integer; + +begin + linecnt := 1; + anscol := indent + Image1.Width div 2; + ReadMAItem(item, R1); + CorrectAnswer := ''; + for i := 1 to R1.NoItems do + begin + CorrectAnswer := CorrectAnswer + R1.CorChoices[i]; + if i < R1.NoItems then CorrectAnswer := CorrectAnswer + ', '; + end; + X := 1; + Y := linecnt * LineHi; + S := 'Directions: Enter a sequence of letter choices separated by commas'; + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + Y := linecnt * LineHi; + S := ' in the answer area below the items.'; + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 2; + Y := linecnt * LineHi; + X := 1; + S := format('Matching Item Set %d',[R1.SetNo]); + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + if length(R1.Picture) > 0 then + begin + Grect.Top := linecnt * LineHi; + Grect.Left := indent; + Grect.Right := (3 * ClientWidth div 4) - indent; + Grect.Bottom := Grect.Top + ClientHeight div 3; + BitMap := TBitMap.Create; + if FileExists(R1.Picture) { *Converted from FileExists* } then + begin + Bitmap.LoadFromFile(R1.Picture); + Image1.Canvas.stretchdraw(Grect,Bitmap); + end + else ShowMessage('Image ' + R1.Picture + ' missing.'); + Bitmap.Free; + linecnt := linecnt + (ClientHeight div 3) div LineHi; + linecnt := linecnt + 2; + end; + itemstartY := linecnt; + for j := 1 to R1.NoItems do + begin + X := 1; + Y := linecnt * LineHi; + S := format('Item %d (Matching Item)',[itemno]); + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + S := trim(R1.ItemStems[j]); + X := 10; + Y := linecnt * LineHi; + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + itemno := itemno + 1; + end; + linecnt := itemstartY; + for j := 1 to R1.NoChoices do + begin + S := chr(j-1 + ord('A')) + ': '; + S := S + trim(R1.ItemChoices[j]); + X := anscol; + Y := linecnt * LineHi; + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 2; + end; + CompTestFrm.itemno := itemno - 1; +end; +//------------------------------------------------------------------- + +procedure TBlankFrm.ShowCOItem(Sender : TObject; itemno,item : integer); +var + j : integer; + S : string; + X, Y : integer; + +begin + linecnt := 1; + ReadCOItem(item,R2); + CorrectAnswer := ''; + CorrectAnswer := CorrectAnswer + R2.BestAns; + Y := linecnt * LineHi; + X := indent; + S := format('Item %d (Completion)',[itemno]); + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + if length(R2.Picture) > 0 then + begin + Grect.Top := linecnt * LineHi; + Grect.Left := indent; + Grect.Right := (3 * ClientWidth div 4) - indent; + Grect.Bottom := Grect.Top + ClientHeight div 3; + BitMap := TBitMap.Create; + if FileExists(R2.Picture) { *Converted from FileExists* } then + begin + Bitmap.LoadFromFile(R2.Picture); + Image1.Canvas.stretchdraw(Grect,Bitmap); + end + else ShowMessage('Image ' + R2.Picture + ' missing.'); + Bitmap.Free; + linecnt := linecnt + (ClientHeight div 3) div LineHi; + linecnt := linecnt + 2; + end; + for j := 1 to 10 do + begin + if length(R2.ItemStem[j]) > 0 then + begin + S := trim(R2.ItemStem[j]); + X := indent; + Y := linecnt * LineHi; + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + end; + end; +end; +//------------------------------------------------------------------- + +procedure TBlankFrm.ShowESItem(Sender : TObject; itemno,item : integer); +var + j : integer; + S : string; + X, Y : integer; + +begin + linecnt := 1; + ReadESItem(item, R4); + CorrectAnswer := 'None Given'; + Y := linecnt * LineHi; + X := indent; + S := format('Item %d (Essay Item)',[itemno]); + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + if length(R4.Picture) > 0 then + begin + Grect.Top := linecnt * LineHi; + Grect.Left := indent; + Grect.Right := (3 * ClientWidth div 4) - indent; + Grect.Bottom := Grect.Top + ClientHeight div 3; + BitMap := TBitMap.Create; + if FileExists(R4.Picture) { *Converted from FileExists* } then + begin + Bitmap.LoadFromFile(R4.Picture); + Image1.Canvas.stretchdraw(Grect,Bitmap); + end + else ShowMessage('Image ' + R4.Picture + ' missing.'); + Bitmap.Free; + linecnt := linecnt + (ClientHeight div 3) div LineHi; + linecnt := linecnt + 2; + end; + for j := 1 to 20 do + begin + if length(R4.ItemStem[j]) > 0 then + begin + S := trim(R4.ItemStem[j]); + X := indent; + Y := linecnt * LineHi; + Image1.Canvas.TextOut(X,Y,S); + linecnt := linecnt + 1; + end; + end; +end; +//------------------------------------------------------------------- + +procedure TBlankFrm.FormShow(Sender: TObject); +begin + // setup parameters + FontHi := Image1.Canvas.TextHeight('M'); + FontWide := Image1.Canvas.TextWidth('M'); + Indent := 10 * FontWide; + LineWidth := 60 * FontWide; + LineHi := FontHi + 5; + PageHi := Image1.ClientHeight; + ImageHi := PageHi; + PageWide := Image1.ClientWidth; + ImageWide := PageWide; + Image1.Canvas.Brush.Color := clWhite; + Image1.Canvas.Rectangle(0,0,ImageWide,ImageHi); + case itemtype of + 1: ShowMCItem(Self,itemno,item); + 2: ShowTFItem(Self,itemno,item); + 3: ShowMAItem(Self,itemno,item); + 4: ShowCOItem(Self,itemno,item); + 5: ShowESItem(Self,itemno,item); + end; +end; + +end. diff --git a/applications/lazstats/source/not used by LazStats/completionitemunit.lfm b/applications/lazstats/source/not used by LazStats/completionitemunit.lfm new file mode 100644 index 000000000..e8ca552b5 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/completionitemunit.lfm @@ -0,0 +1,301 @@ +object CompletionItemFrm: TCompletionItemFrm + Left = 100 + Height = 384 + Top = 108 + Width = 591 + HelpContext = 1850 + BorderStyle = bsDialog + Caption = 'Blank Completion Item Specification' + ClientHeight = 384 + ClientWidth = 591 + Color = clBtnFace + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + HelpFile = 'ITEMBANKHELP.HLP' + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Label2: TLabel + Left = 16 + Height = 13 + Top = 8 + Width = 63 + Caption = 'Item Number:' + ParentColor = False + end + object Label1: TLabel + Left = 160 + Height = 13 + Top = 8 + Width = 281 + Caption = 'Click on the Item Classification Code listed in the box below.' + ParentColor = False + end + object Label14: TLabel + Left = 16 + Height = 13 + Top = 64 + Width = 89 + Caption = 'Bit Map File Name:' + ParentColor = False + end + object Label15: TLabel + Left = 16 + Height = 13 + Top = 88 + Width = 72 + Caption = 'Image (if used):' + ParentColor = False + end + object Label16: TLabel + Left = 120 + Height = 13 + Top = 80 + Width = 97 + Caption = '(Thumb Nail Sketch)' + ParentColor = False + end + object BMPImage: TImage + Left = 112 + Height = 97 + Top = 96 + Width = 121 + Center = True + Stretch = True + end + object Label18: TLabel + Left = 248 + Height = 13 + Top = 96 + Width = 60 + Caption = 'Item Weight:' + ParentColor = False + end + object Label3: TLabel + Left = 16 + Height = 13 + Top = 200 + Width = 47 + Caption = 'Item Stem' + ParentColor = False + end + object Label4: TLabel + Left = 16 + Height = 13 + Top = 312 + Width = 89 + Caption = 'Suggested Answer' + ParentColor = False + end + object ItemNoEdit: TEdit + Left = 104 + Height = 21 + Top = 0 + Width = 41 + TabOrder = 0 + end + object ItemNoScroll: TScrollBar + Left = 16 + Height = 16 + Top = 28 + Width = 129 + Max = 1000 + PageSize = 0 + TabOrder = 1 + OnScroll = ItemNoScrollScroll + end + object CodeCombo: TComboBox + Left = 160 + Height = 21 + Top = 24 + Width = 417 + ItemHeight = 13 + TabOrder = 2 + Text = 'Classification Code' + end + object BMPFileEdit: TEdit + Left = 112 + Height = 21 + Top = 56 + Width = 465 + TabOrder = 3 + Text = 'BMPFileEdit' + end + object BrowseBtn: TButton + Left = 24 + Height = 25 + Top = 112 + Width = 57 + Caption = 'Browse' + OnClick = BrowseBtnClick + TabOrder = 4 + end + object ClearBtn: TButton + Left = 24 + Height = 25 + Top = 144 + Width = 57 + Caption = 'Clear' + OnClick = ClearBtnClick + TabOrder = 5 + end + object ItemWeightEdit: TEdit + Left = 312 + Height = 21 + Top = 96 + Width = 33 + TabOrder = 6 + Text = 'ItemWeightEdit' + end + object Panel1: TPanel + Left = 408 + Height = 137 + Top = 80 + Width = 169 + ClientHeight = 137 + ClientWidth = 169 + TabOrder = 7 + object Label9: TLabel + Left = 6 + Height = 13 + Top = 14 + Width = 78 + Caption = 'Percent Passed:' + ParentColor = False + end + object Label10: TLabel + Left = 6 + Height = 13 + Top = 38 + Width = 97 + Caption = 'Log Difficulty (IRT1):' + ParentColor = False + end + object Label11: TLabel + Left = 6 + Height = 13 + Top = 62 + Width = 86 + Caption = 'Item Slope (IRT2):' + ParentColor = False + end + object Label12: TLabel + Left = 6 + Height = 13 + Top = 86 + Width = 96 + Caption = 'Item Chance (IRT3):' + ParentColor = False + end + object Label13: TLabel + Left = 6 + Height = 13 + Top = 110 + Width = 76 + Caption = 'Times Selected:' + ParentColor = False + end + object PcntEdit: TEdit + Left = 110 + Height = 21 + Top = 6 + Width = 41 + TabOrder = 0 + end + object IRT1Edit: TEdit + Left = 110 + Height = 21 + Top = 30 + Width = 41 + TabOrder = 1 + end + object IRT2Edit: TEdit + Left = 110 + Height = 21 + Top = 54 + Width = 41 + TabOrder = 2 + end + object IRT3Edit: TEdit + Left = 110 + Height = 21 + Top = 78 + Width = 41 + TabOrder = 3 + end + object NoSelEdit: TEdit + Left = 110 + Height = 21 + Top = 102 + Width = 41 + TabOrder = 4 + end + end + object StemMemo: TMemo + Left = 16 + Height = 73 + Top = 224 + Width = 561 + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'MS Sans Serif' + MaxLength = 1000 + ParentFont = False + ScrollBars = ssVertical + TabOrder = 8 + WantTabs = True + WordWrap = False + end + object NewBtn: TButton + Left = 16 + Height = 25 + Top = 355 + Width = 73 + Caption = 'New Item' + OnClick = NewBtnClick + TabOrder = 9 + end + object SaveBtn: TButton + Left = 112 + Height = 25 + Top = 355 + Width = 73 + Caption = 'Save Item' + OnClick = SaveBtnClick + TabOrder = 10 + end + object DeleteBtn: TButton + Left = 208 + Height = 25 + Top = 355 + Width = 73 + Caption = 'Delete' + OnClick = DeleteBtnClick + TabOrder = 11 + end + object ReturnBtn: TButton + Left = 504 + Height = 25 + Top = 355 + Width = 73 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 12 + end + object AnswerEdit: TEdit + Left = 16 + Height = 21 + Top = 328 + Width = 561 + TabOrder = 13 + end + object OpenPictureDialog1: TOpenPictureDialog + left = 328 + top = 352 + end + object OpenDialog1: TOpenDialog + left = 384 + top = 352 + end +end diff --git a/applications/lazstats/source/not used by LazStats/completionitemunit.pas b/applications/lazstats/source/not used by LazStats/completionitemunit.pas new file mode 100644 index 000000000..bd4c97b3d --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/completionitemunit.pas @@ -0,0 +1,336 @@ +unit CompletionItemUnit; + +{$MODE Delphi} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, ItemBankGlobals, ExtDlgs, FunctionsUnit; + +type + TCompletionItemFrm = class(TForm) + Label2: TLabel; + ItemNoEdit: TEdit; + ItemNoScroll: TScrollBar; + Label1: TLabel; + CodeCombo: TComboBox; + Label14: TLabel; + BMPFileEdit: TEdit; + Label15: TLabel; + BrowseBtn: TButton; + ClearBtn: TButton; + Label16: TLabel; + BMPImage: TImage; + Label18: TLabel; + ItemWeightEdit: TEdit; + Panel1: TPanel; + Label9: TLabel; + Label10: TLabel; + Label11: TLabel; + Label12: TLabel; + Label13: TLabel; + PcntEdit: TEdit; + IRT1Edit: TEdit; + IRT2Edit: TEdit; + IRT3Edit: TEdit; + NoSelEdit: TEdit; + Label3: TLabel; + StemMemo: TMemo; + NewBtn: TButton; + SaveBtn: TButton; + DeleteBtn: TButton; + ReturnBtn: TButton; + AnswerEdit: TEdit; + Label4: TLabel; + OpenPictureDialog1: TOpenPictureDialog; + OpenDialog1: TOpenDialog; + procedure FormShow(Sender: TObject); + procedure ShowBlankItem(Sender: TObject; itemno : integer); + procedure ReturnBtnClick(Sender: TObject); + procedure NewBtnClick(Sender: TObject); + procedure SaveBtnClick(Sender: TObject); + procedure LoadRecord(VAR NewRcd : BlankItemRcd; Sender : TObject); + procedure DeleteBtnClick(Sender: TObject); + procedure BrowseBtnClick(Sender: TObject); + procedure ItemNoScrollScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); + procedure ClearBtnClick(Sender: TObject); + private + { Private declarations } + maxitems : integer; + ARcd : BlankItemRcd; + public + { Public declarations } + end; + +var + CompletionItemFrm: TCompletionItemFrm; + +implementation + +{$R *.lfm} + +procedure TCompletionItemFrm.FormShow(Sender: TObject); +var + F : TextFile; + S : string; + TF : File of BlankItemRcd; +begin + StemMemo.Clear; + AnswerEdit.Text := ''; + ItemNoScroll.Min := 1; + ItemNoScroll.Max := 1; + ItemNoEdit.Text := '1'; + ItemNoScroll.Position := 1; + CodeCombo.Text := ''; + BMPFileEdit.Text := ''; + PcntEdit.Text := '0'; + IRT1Edit.Text := '0'; + IRT2Edit.Text := '0'; + IRT3Edit.Text := '0'; + NoSelEdit.Text := '0'; + ItemWeightEdit.Text := '0'; + maxitems := 0; + OpenDialog1.DefaultExt := '.COD'; + OpenDialog1.Filter := 'Code files (*.cod)|*.COD|Text files (*.txt)|*.TXT|All files (*.*)|*.*'; + OpenDialog1.FilterIndex := 1; + OpenDialog1.FileName := BankPath + ExtractFileName(BankName) + '.COD'; + OpenDialog1.Title := 'Name of Item Code File:'; + if OpenDialog1.Execute then + begin + AssignFile(F,OpenDialog1.filename); + ReSet(F); + while not EOF(F) do + begin + readln(F,S); + CodeCombo.Items.Add(S); + end; + end + else begin + ShowMessage('You must first open a file of item codes.'); + exit; + end; + CloseFile(F); + S := BankPath + 'BlankFile' + ExtractFileName(BankName); + BlankFName := S; + if FileExists(S) { *Converted from FileExists* } then + begin + AssignFile(TF,S); + Reset(TF); + while not EOF(TF) do + begin + read(TF,ARcd); + maxitems := maxitems + 1; + end; + CloseFile(TF); + if maxitems > ItemNoScroll.Max then + ItemNoScroll.Max := maxitems; + ItemNoScroll.Min := 1; + end + else begin // create empty file + AssignFile(TF,S); + rewrite(TF); + CloseFile(TF); + end; + ARcd.BestAns := ''; + if maxitems > 0 then + begin + ItemNoScroll.Position := 1; + ShowBlankItem(self,1); + end; +end; +//------------------------------------------------------------------- +procedure TCompletionItemFrm.ShowBlankItem(Sender: TObject; itemno : integer); +var + S : string; + F : File of BlankItemRcd; + where : longint; + Frecd : BlankItemRcd; + i : integer; + +begin + ItemNoEdit.Text := IntToStr(ItemNoScroll.Position); + S := BankPath + 'BlankFile' + ExtractFileName(BankName); + AssignFile(F,S); + Reset(F); + where := itemno-1; + Seek(F,where); + read(F,FRecd); + CloseFile(F); + CodeCombo.Text := Frecd.Code; + BMPFileEdit.Text := Frecd.Picture; + PcntEdit.Text := FloatToStr(Frecd.PcntPass); + if BMPFileEdit.Text <> '' then + begin + if FileExists(Frecd.Picture) { *Converted from FileExists* } then + begin + BMPImage.Picture.LoadFromFile(Frecd.Picture); + BMPImage.Visible := true; + end + else begin +// ShowMessage('Image ' + Frecd.Picture + ' not found.'); + BMPFileEdit.Text := ''; + Frecd.Picture := ''; + end; + end + else BMPImage.Visible := false; + ItemWeightEdit.Text := IntToStr(Frecd.ItemWeight); + IRT1Edit.Text := FloatToStr(Frecd.IRT[1]); + IRT2Edit.Text := FloatToStr(Frecd.IRT[2]); + IRT3Edit.Text := FLoatToStr(Frecd.IRT[3]); + StemMemo.Clear; + for i := 1 to 10 do + begin + S := Frecd.ItemStem[i]; + if length(S) > 0 then StemMemo.Lines.Add(S); + end; + AnswerEdit.Text := Frecd.BestAns; + +end; +//------------------------------------------------------------------- + +procedure TCompletionItemFrm.ReturnBtnClick(Sender: TObject); +begin + CompletionItemFrm.Hide; +end; +//------------------------------------------------------------------- + +procedure TCompletionItemFrm.NewBtnClick(Sender: TObject); +begin + StemMemo.Clear; + AnswerEdit.Text := ''; + ItemNoScroll.Max := maxitems + 1; + ItemNoScroll.Position := ItemNoScroll.Max; + ItemNoEdit.Text := IntToStr(ItemNoScroll.Position); + CodeCombo.Text := ''; + BMPFileEdit.Text := ''; + BMPImage.Visible := false; + PcntEdit.Text := '0'; + IRT1Edit.Text := '0'; + IRT2Edit.Text := '0'; + IRT3Edit.Text := '0'; + NoSelEdit.Text := '0'; + ItemWeightEdit.Text := '0'; + BMPImage.Visible := false; +end; +//------------------------------------------------------------------- + +procedure TCompletionItemFrm.SaveBtnClick(Sender: TObject); +var + NewRcd : BlankItemRcd; + itemno : integer; +begin + itemno := ItemNoScroll.Position; + LoadRecord(NewRcd,self); + WriteCOItem(itemno,NewRcd); + if itemno > maxitems then + begin + maxitems := itemno; + ItemNoScroll.Max := maxitems+1; + end; +end; +//------------------------------------------------------------------- +procedure TCompletionItemFrm.LoadRecord(VAR NewRcd : BlankItemRcd; Sender : TObject); +var + i : integer; + S : string; +begin + NewRcd.ItemNo := ItemNoScroll.Position; + NewRcd.Code := CodeCombo.Text; + for i := 0 to StemMemo.Lines.Count-1 do + begin + S := Trim(StemMemo.Lines[i]); + NewRcd.ItemStem[i+1] := S; + end; + if StemMemo.Lines.Count < 10 then + for i := StemMemo.Lines.Count+1 to 10 do NewRcd.ItemStem[i] := ''; + NewRcd.BestAns := AnswerEdit.Text; + NewRcd.ItemWeight := StrToInt(ItemWeightEdit.Text); + NewRcd.Picture := BMPFileEdit.Text; + NewRcd.PcntPass := StrToFloat(PcntEdit.Text); + NewRcd.IRT[1] := StrToFloat(IRT1Edit.Text); + NewRcd.IRT[2] := StrToFloat(IRT2Edit.Text); + NewRcd.IRT[3] := StrToFloat(IRT3Edit.Text); + NewRcd.FreqElect := StrToInt(NoSelEdit.Text); +end; +//------------------------------------------------------------------- + +procedure TCompletionItemFrm.DeleteBtnClick(Sender: TObject); +var + FOld : File of BlankItemRcd; + FNew : File of BlankItemRcd; + itemno : integer; + i : integer; + SOld : string; + SNew : string; +begin + itemno := ItemNoScroll.Position; + SOld := BankPath + 'BlankFile' + ExtractFileName(BankName); + AssignFile(FOld,SOld); + ReSet(FOld); + SNew := BankPath + 'TempBlankFile'; + AssignFile(FNew,SNew); + Rewrite(FNew); + // copy up to itemno from old file to new file + for i := 1 to itemno-1 do + begin + if not EOF(FOld) then + begin + read(FOld,ARcd); + write(FNew,ARcd); + end; + end; + // read past itemno to delete + if not EOF(FOld) then read(FOld,ARcd); + // write remaining records, if any, from old to new + if not EOF(FOld) then + begin + while not EOF(FOld) do + begin + read(FOld,ARcd); + write(FNew,ARcd); + end; + end; + CloseFile(FOld); + CloseFile(FNew); + // delete old file and rename temp file to old file name + DeleteFile(SOld); { *Converted from DeleteFile* } + RenameFile(SNew, Sold); { *Converted from RenameFile* } + maxitems := maxitems - 1; + if maxitems > 0 then ItemNoScroll.Max := maxitems else + ItemNoScroll.Max := 1; +end; +//------------------------------------------------------------------- + +procedure TCompletionItemFrm.BrowseBtnClick(Sender: TObject); +begin + if OpenPictureDialog1.Execute then + begin + BMPFileEdit.Text := OpenPictureDialog1.FileName; + BMPImage.Picture.LoadFromFile(BMPFileEdit.Text); + BMPImage.Visible := true; + end; +end; +//------------------------------------------------------------------- + +procedure TCompletionItemFrm.ItemNoScrollScroll(Sender: TObject; + ScrollCode: TScrollCode; var ScrollPos: Integer); +var + itemno : integer; +begin + itemno := ScrollPos; + if (itemno > maxitems) or (itemno < 1) then exit; + ItemNoEdit.Text := IntToStr(itemno); + ShowBlankItem(self,itemno); +end; +//------------------------------------------------------------------- + +procedure TCompletionItemFrm.ClearBtnClick(Sender: TObject); +begin + BMPFileEdit.Text := ''; + BMPImage.Visible := false; +end; +//------------------------------------------------------------------- + +end. diff --git a/applications/lazstats/source/not used by LazStats/comptestunit.lfm b/applications/lazstats/source/not used by LazStats/comptestunit.lfm new file mode 100644 index 000000000..26d96610f --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/comptestunit.lfm @@ -0,0 +1,124 @@ +object CompTestFrm: TCompTestFrm + Left = 32 + Top = 62 + Width = 389 + Height = 235 + Caption = 'Computer Administered Test' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OnShow = FormShow + PixelsPerInch = 96 + object Label1: TLabel + Left = 8 + Top = 48 + Width = 110 + Height = 13 + Caption = 'Enter your LAST name:' + end + object Label2: TLabel + Left = 8 + Top = 144 + Width = 150 + Height = 13 + Caption = 'Save the results in a file named:' + end + object Label3: TLabel + Left = 8 + Top = 80 + Width = 114 + Height = 13 + Caption = 'Enter your FIRST name:' + end + object Label4: TLabel + Left = 8 + Top = 112 + Width = 154 + Height = 13 + Caption = 'Enter your Identification Number:' + end + object LastNameEdit: TEdit + Left = 192 + Top = 40 + Width = 177 + Height = 21 + TabOrder = 2 + end + object TestNameEdit: TEdit + Left = 192 + Top = 8 + Width = 177 + Height = 21 + TabOrder = 1 + end + object CancelBtn: TButton + Left = 8 + Top = 176 + Width = 73 + Height = 25 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 7 + OnClick = CancelBtnClick + end + object StartBtn: TButton + Left = 152 + Top = 176 + Width = 73 + Height = 25 + Caption = 'Start Test' + TabOrder = 6 + OnClick = StartBtnClick + end + object ExitBtn: TButton + Left = 296 + Top = 176 + Width = 73 + Height = 25 + Caption = 'Exit' + ModalResult = 1 + TabOrder = 8 + OnClick = ExitBtnClick + end + object Button1: TButton + Left = 8 + Top = 8 + Width = 145 + Height = 25 + Caption = 'Click to find test files' + TabOrder = 0 + OnClick = Button1Click + end + object SaveFileEdit: TEdit + Left = 192 + Top = 136 + Width = 177 + Height = 21 + TabOrder = 5 + end + object FirstNameEdit: TEdit + Left = 192 + Top = 72 + Width = 177 + Height = 21 + TabOrder = 3 + end + object IDnoEdit: TEdit + Left = 192 + Top = 104 + Width = 177 + Height = 21 + TabOrder = 4 + end + object OpenDialog1: TOpenDialog + Left = 240 + Top = 176 + end + object SaveDialog1: TSaveDialog + Left = 104 + Top = 176 + end +end diff --git a/applications/lazstats/source/not used by LazStats/concordance.lfm b/applications/lazstats/source/not used by LazStats/concordance.lfm new file mode 100644 index 000000000..4b1db87d1 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/concordance.lfm @@ -0,0 +1,165 @@ +object ConcordFrm: TConcordFrm + Left = 279 + Height = 243 + Top = 216 + Width = 536 + HelpContext = 1305 + BorderStyle = bsDialog + Caption = 'Kendal''s Coefficient of Concordance' + ClientHeight = 243 + ClientWidth = 536 + Color = clBtnFace + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + HelpFile = 'OS2Help.hlp' + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Label1: TLabel + Left = 24 + Height = 13 + Top = 8 + Width = 92 + Caption = 'Available Variables:' + ParentColor = False + end + object Label2: TLabel + Left = 200 + Height = 13 + Top = 8 + Width = 91 + Caption = 'Selected Variables:' + ParentColor = False + end + object VarList: TListBox + Left = 8 + Height = 201 + Top = 24 + Width = 129 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + Left = 144 + Height = 33 + Top = 32 + Width = 33 + Glyph.Data = { + 76010000424D7601000000000000760000002800000020000000100000000100 + 04000000000000010000120B0000120B00001000000000000000000000000000 + 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3333333333333333333333333333333333333333333333333333333333333333 + 3333333333333333333333333333333333333333333FF3333333333333003333 + 3333333333773FF3333333333309003333333333337F773FF333333333099900 + 33333FFFFF7F33773FF30000000999990033777777733333773F099999999999 + 99007FFFFFFF33333F7700000009999900337777777F333F7733333333099900 + 33333333337F3F77333333333309003333333333337F77333333333333003333 + 3333333333773333333333333333333333333333333333333333333333333333 + 3333333333333333333333333333333333333333333333333333 + } + NumGlyphs = 2 + OnClick = InBtnClick + TabOrder = 1 + end + object OutBtn: TBitBtn + Left = 144 + Height = 33 + Top = 72 + Width = 33 + Glyph.Data = { + 76010000424D7601000000000000760000002800000020000000100000000100 + 04000000000000010000120B0000120B00001000000000000000000000000000 + 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3333333333333333333333333333333333333333333333333333333333333333 + 3333333333333FF3333333333333003333333333333F77F33333333333009033 + 333333333F7737F333333333009990333333333F773337FFFFFF330099999000 + 00003F773333377777770099999999999990773FF33333FFFFF7330099999000 + 000033773FF33777777733330099903333333333773FF7F33333333333009033 + 33333333337737F3333333333333003333333333333377333333333333333333 + 3333333333333333333333333333333333333333333333333333333333333333 + 3333333333333333333333333333333333333333333333333333 + } + NumGlyphs = 2 + OnClick = OutBtnClick + TabOrder = 2 + end + object AllBtn: TBitBtn + Left = 144 + Height = 33 + Top = 136 + Width = 33 + Caption = 'ALL' + OnClick = AllBtnClick + TabOrder = 3 + end + object ListBox1: TListBox + Left = 184 + Height = 201 + Top = 24 + Width = 137 + ItemHeight = 0 + TabOrder = 4 + end + object ResetBtn: TButton + Left = 336 + Height = 25 + Top = 179 + Width = 65 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 5 + end + object CancelBtn: TButton + Left = 456 + Height = 25 + Top = 179 + Width = 65 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 6 + end + object OKBtn: TButton + Left = 456 + Height = 25 + Top = 211 + Width = 65 + Caption = 'Return' + ModalResult = 1 + OnClick = OKBtnClick + TabOrder = 7 + end + object ComputeBtn: TButton + Left = 336 + Height = 25 + Top = 211 + Width = 65 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 8 + end + object Memo1: TMemo + Left = 336 + Height = 169 + Top = 0 + Width = 185 + Lines.Strings = ( + 'Directions: A Judge''s ratings or ' + 'observations are recorded' + 'as Variables (columns) 1 through k. ' + 'Each line corresponds to a different ' + 'judge (person making the rating.) ' + 'Select the variables from the left list ' + 'to analyze and click on the right ' + 'arrow.' + 'Click on the left arrow to remove any ' + 'variables NOT to be analyzed. Click ' + 'on the Compute button to obtain the' + 'results. ' + ) + TabOrder = 9 + end +end diff --git a/applications/lazstats/source/not used by LazStats/concordance.lrs b/applications/lazstats/source/not used by LazStats/concordance.lrs new file mode 100644 index 000000000..1571339da --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/concordance.lrs @@ -0,0 +1,59 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TConcordFrm','FORMDATA',[ + 'TPF0'#11'TConcordFrm'#10'ConcordFrm'#4'Left'#3#23#1#6'Height'#3#243#0#3'Top' + +#3#216#0#5'Width'#3#24#2#11'HelpContext'#3#25#5#11'BorderStyle'#7#8'bsDialog' + +#7'Caption'#6'#Kendal''s Coefficient of Concordance'#12'ClientHeight'#3#243#0 + +#11'ClientWidth'#3#24#2#5'Color'#7#9'clBtnFace'#10'Font.Color'#7#12'clWindow' + +'Text'#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#8'HelpFile'#6 + +#11'OS2Help.hlp'#6'OnShow'#7#8'FormShow'#10'LCLVersion'#6#7'2.1.0.0'#0#6'TLa' + +'bel'#6'Label1'#4'Left'#2#24#6'Height'#2#13#3'Top'#2#8#5'Width'#2'\'#7'Capti' + +'on'#6#20'Available Variables:'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4 + +'Left'#3#200#0#6'Height'#2#13#3'Top'#2#8#5'Width'#2'['#7'Caption'#6#19'Selec' + +'ted Variables:'#11'ParentColor'#8#0#0#8'TListBox'#7'VarList'#4'Left'#2#8#6 + +'Height'#3#201#0#3'Top'#2#24#5'Width'#3#129#0#10'ItemHeight'#2#0#11'MultiSel' + +'ect'#9#8'TabOrder'#2#0#0#0#7'TBitBtn'#5'InBtn'#4'Left'#3#144#0#6'Height'#2 + +'!'#3'Top'#2' '#5'Width'#2'!'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0 + +#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#18#11#0 + +#0#18#11#0#0#16#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0 + +#0#128#0#128#0#128#128#0#0#127#127#127#0#191#191#191#0#0#0#255#0#0#255#0#0#0 + +#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0'33333333333333333' + +'333333333333333333333333333333333333333333?'#243'333333'#0'3333333w?'#243'3' + +'3333'#9#0'333333'#127'w?'#243'3333'#9#153#0'33?'#255#255#127'3w?'#243#0#0#0 + +#9#153#153#0'3wwws33w?'#9#153#153#153#153#153#153#0#127#255#255#255'33?w'#0#0 + +#0#9#153#153#0'3www'#127'3?w3333'#9#153#0'33333'#127'?w33333'#9#0'333333'#127 + +'w333333'#0'3333333w3333333333333333333333333333333333333333333333333333'#9 + +'NumGlyphs'#2#2#7'OnClick'#7#10'InBtnClick'#8'TabOrder'#2#1#0#0#7'TBitBtn'#6 + +'OutBtn'#4'Left'#3#144#0#6'Height'#2'!'#3'Top'#2'H'#5'Width'#2'!'#10'Glyph.D' + +'ata'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0 + +#0#0#1#0#4#0#0#0#0#0#0#1#0#0#18#11#0#0#18#11#0#0#16#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#127#127#127#0 + +#191#191#191#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255 + +#0#0#255#255#255#0'33333333333333333333333333333333333333333333?'#243'333333' + +#0'333333?w'#243'33333'#0#144'33333?w7'#243'3333'#0#153#144'3333?w37'#255#255 + +#255'3'#0#153#153#144#0#0#0'?w337www'#0#153#153#153#153#153#153#144'w?'#243 + +'33'#255#255#247'3'#0#153#153#144#0#0#0'3w?'#243'7www33'#0#153#144'33333w?' + +#247#243'33333'#0#144'333333w7'#243'333333'#0'3333333w3333333333333333333333' + +'333333333333333333333333333333333333333333333'#9'NumGlyphs'#2#2#7'OnClick'#7 + +#11'OutBtnClick'#8'TabOrder'#2#2#0#0#7'TBitBtn'#6'AllBtn'#4'Left'#3#144#0#6 + +'Height'#2'!'#3'Top'#3#136#0#5'Width'#2'!'#7'Caption'#6#3'ALL'#7'OnClick'#7 + +#11'AllBtnClick'#8'TabOrder'#2#3#0#0#8'TListBox'#8'ListBox1'#4'Left'#3#184#0 + +#6'Height'#3#201#0#3'Top'#2#24#5'Width'#3#137#0#10'ItemHeight'#2#0#8'TabOrde' + +'r'#2#4#0#0#7'TButton'#8'ResetBtn'#4'Left'#3'P'#1#6'Height'#2#25#3'Top'#3#179 + +#0#5'Width'#2'A'#7'Caption'#6#5'Reset'#7'OnClick'#7#13'ResetBtnClick'#8'TabO' + +'rder'#2#5#0#0#7'TButton'#9'CancelBtn'#4'Left'#3#200#1#6'Height'#2#25#3'Top' + +#3#179#0#5'Width'#2'A'#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#7'OnClick' + +#7#14'CancelBtnClick'#8'TabOrder'#2#6#0#0#7'TButton'#5'OKBtn'#4'Left'#3#200#1 + +#6'Height'#2#25#3'Top'#3#211#0#5'Width'#2'A'#7'Caption'#6#6'Return'#11'Modal' + +'Result'#2#1#7'OnClick'#7#10'OKBtnClick'#8'TabOrder'#2#7#0#0#7'TButton'#10'C' + +'omputeBtn'#4'Left'#3'P'#1#6'Height'#2#25#3'Top'#3#211#0#5'Width'#2'A'#7'Cap' + +'tion'#6#7'Compute'#7'OnClick'#7#15'ComputeBtnClick'#8'TabOrder'#2#8#0#0#5'T' + +'Memo'#5'Memo1'#4'Left'#3'P'#1#6'Height'#3#169#0#3'Top'#2#0#5'Width'#3#185#0 + +#13'Lines.Strings'#1#6'#Directions: A Judge''s ratings or '#6#25'observati' + +'ons are recorded'#6'%as Variables (columns) 1 through k. '#6'%Each line co' + +'rresponds to a different '#6'#judge (person making the rating.) '#6'(Selec' + +'t the variables from the left list '#6'"to analyze and click on the right ' + +#6#6'arrow.'#6'&Click on the left arrow to remove any '#6'%variables NOT to ' + +'be analyzed. Click '#6'#on the Compute button to obtain the'#6#9'results. ' + +#0#8'TabOrder'#2#9#0#0#0 +]); diff --git a/applications/lazstats/source/not used by LazStats/concordance.pas b/applications/lazstats/source/not used by LazStats/concordance.pas new file mode 100644 index 000000000..ca808fa24 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/concordance.pas @@ -0,0 +1,368 @@ +unit Concordance; + +{$MODE Delphi} + +interface + +uses + LCLIntf, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Buttons, OS3MainUnit, GLOBALS, OUTPUTUNIT, DATAPROCS, Math, + FUNCTIONSLIB, LResources; + +type + TConcordFrm = class(TForm) + Label1: TLabel; + VarList: TListBox; + InBtn: TBitBtn; + OutBtn: TBitBtn; + AllBtn: TBitBtn; + Label2: TLabel; + ListBox1: TListBox; + ResetBtn: TButton; + CancelBtn: TButton; + OKBtn: TButton; + ComputeBtn: TButton; + Memo1: TMemo; + procedure ResetBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure CancelBtnClick(Sender: TObject); + procedure OKBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + procedure AllBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + ConcordFrm: TConcordFrm; + +implementation + + +procedure TConcordFrm.ResetBtnClick(Sender: TObject); +var + i: integer; +begin + VarList.Clear; + ListBox1.Clear; + for i := 1 to NoVariables do + begin + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + end; + InBtn.Enabled := true; + OutBtn.Enabled := false; +end; +//------------------------------------------------------------------- + +procedure TConcordFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; +//------------------------------------------------------------------- + +procedure TConcordFrm.CancelBtnClick(Sender: TObject); +begin + ConcordFrm.Hide; +end; +//------------------------------------------------------------------- + +procedure TConcordFrm.OKBtnClick(Sender: TObject); +begin + ConcordFrm.Hide; +end; +//------------------------------------------------------------------- + +procedure TConcordFrm.InBtnClick(Sender: TObject); +var + index, i : integer; + +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + ListBox1.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + + OutBtn.Enabled := true; +end; +//------------------------------------------------------------------- + +procedure TConcordFrm.OutBtnClick(Sender: TObject); +var + index: integer; + +begin + index := ListBox1.ItemIndex; + VarList.Items.Add(ListBox1.Items.Strings[index]); + ListBox1.Items.Delete(index); + InBtn.Enabled := true; +end; +//------------------------------------------------------------------- + +procedure TConcordFrm.AllBtnClick(Sender: TObject); +var + count, index : integer; +begin + count := VarList.Items.Count; + if count = 0 then exit; + for index := 0 to count-1 do + begin + ListBox1.Items.Add(VarList.Items.Strings[index]); + end; + VarList.Clear; + InBtn.Visible := false; + OutBtn.Visible := true; +end; +//------------------------------------------------------------------- + +procedure TConcordFrm.ComputeBtnClick(Sender: TObject); +var + i, j, k, index, No_Judges, No_Objects, col, ties, start, last : integer; + NoSelected : integer; + Temp, TotalCorrect, JudgeCorrect, ChiSquare, Probability : double; + TotalRankSums, Concordance, AvgRankCorr, AvgTotalRanks : double; + statistic : double; + scorearray : DblDyneMat; + temprank, ObjRankSums : DblDyneVec; + tempindex : IntDyneVec; + done : boolean; + value, cellstring, outline : string; + ColNoSelected : IntDyneVec; + ColLabels : StrDyneVec; + +begin + No_Judges := 0; + No_Objects := ListBox1.Items.Count; + + // Allocate space for selected variable column no.s + SetLength(scorearray,NoCases,No_Objects); + SetLength(tempindex,No_Objects); + SetLength(temprank,No_Objects); + SetLength(ObjRankSums,No_Objects); + SetLength(ColLabels,NoVariables); + SetLength(ColNoSelected,NoVariables); + + // get columns of variables selected + for i := 0 to No_Objects - 1 do + begin + cellstring := ListBox1.Items.Strings[i]; + for index := 1 to NoVariables do + begin + if (cellstring = OS3MainFrm.DataGrid.Cells[index,0]) then + begin + ColNoSelected[i] := index; + ColLabels[i] := cellstring; + end; + end; + end; + + //Read data from grid + for i := 1 to NoCases do + begin + if (not GoodRecord(i,No_Objects,ColNoSelected)) then continue; + No_Judges := No_Judges + 1; + for j := 1 to No_Objects do + begin + col := ColNoSelected[j-1]; + scorearray[i-1,j-1] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); + end; + end; + + //Rank the scores in the rows for each judge (column) + TotalCorrect := 0.0; + for i := 0 to No_Judges-1 do + begin + JudgeCorrect := 0.0; + for j := 0 to No_Objects-1 do + begin + tempindex[j] := j; + temprank[j] := scorearray[i,j]; + end; + //Sort the temp arrays + for j := 0 to No_Objects - 2 do + begin + for k := j + 1 to No_Objects - 1 do + begin + if (temprank[j] > temprank[k]) then + begin + Temp := temprank[j]; + temprank[j] := temprank[k]; + temprank[k] := Temp; + index := tempindex[j]; + tempindex[j] := tempindex[k]; + tempindex[k] := index; + end; + end; + end; + + //Now convert temporary score array to ranks (correcting for ties) + j := 0; + while (j <= No_Objects-1) do + begin + ties := 0; + k := j; + done := false; + while (not done) do + begin + k := k + 1; + if (k <= No_Objects-1) then + begin + if (temprank[j] = temprank[k]) then ties := ties + 1; + end + else done := true; + end; + if (ties = 0.0) then + begin + temprank[j] := j+1; + j := j + 1; + end + else begin + for k := j to j + ties do + begin + temprank[k] := (j+1) + (ties / 2.0); + end; + j := j + ties + 1; + ties := ties + 1; + JudgeCorrect := JudgeCorrect + (Power(ties,3) - ties); + end; + end; + + //Now, restore ranks in their position equivalent to original scores + for j := 0 to No_Objects-1 do + begin + k := tempindex[j]; + scorearray[i,k] := temprank[j]; + end; + TotalCorrect := TotalCorrect + (JudgeCorrect / 12.0); + end; // next judge i + + //Calculate statistics + statistic := 0.0; + TotalRankSums := 0.0; + for j := 0 to No_Objects-1 do + begin + ObjRankSums[j] := 0.0; + for i := 0 to No_Judges-1 do ObjRankSums[j] := ObjRankSums[j] + scorearray[i,j]; + TotalRankSums := TotalRankSums + ObjRankSums[j]; + end; + AvgTotalRanks := TotalRankSums / No_Objects; + for j := 0 to No_Objects-1 do + statistic := statistic + Power((ObjRankSums[j] - AvgTotalRanks), 2); + Concordance := statistic / ( ((No_Judges * No_Judges) / 12.0) * + (Power(No_Objects,3) - No_Objects) - (No_Judges * TotalCorrect) ); + AvgRankCorr := (No_Judges * Concordance - 1.0) / (No_Judges - 1); + ChiSquare := No_Judges * Concordance * (No_Objects - 1); + Probability := 1.0 - chisquaredprob(ChiSquare, No_Objects - 1); + + //Report results + OutPutFrm.RichEdit.Clear; + OutPutFrm.RichEdit.Lines.Add('Kendall Coefficient of Concordance Analysis'); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('Ranks Assigned to Judge Ratings of Objects'); + OutPutFrm.RichEdit.Lines.Add(''); + + for i := 1 to No_Judges do + begin + done := false; + start := 1; + last := 10; + while (not done) do + begin + if (last > No_Objects)then last := No_Objects; + outline := format('Judge %3d',[i]); + outline := outline + ' Objects'; + OutPutFrm.RichEdit.Lines.Add(outline); + outline := ' '; + for j := start to last do + begin + col := ColNoSelected[j-1]; + outline := outline + format('%8s',[ColLabels[col-1]]); + end; + OutPutFrm.RichEdit.Lines.Add(outline); + outline := ' '; + for j := start to last do + begin + value := format('%8.4f',[scorearray[i-1,j-1]]); + outline := outline + value; + end; + OutPutFrm.RichEdit.Lines.Add(outline); + if (last = No_Objects) then done := true + else begin + start := last; + last := start + 10; + end; + outline := ''; + end; // while end + OutPutFrm.RichEdit.Lines.Add(''); + end; // next i + + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('Sum of Ranks for Each Object Judged'); + done := false; + start := 1; + last := 10; + while (not done) do + begin + if (last > No_Objects) then last := No_Objects; + OutPutFrm.RichEdit.Lines.Add(' Objects'); + outline := ' '; + for j := start to last do + begin + col := ColNoSelected[j-1]; + value := format('%8s',[ColLabels[col-1]]); + outline := outline + value; + end; + OutPutFrm.RichEdit.Lines.Add(outline); + outline := ' '; + for j := start to last do + begin + value := format('%8.4f',[ObjRankSums[j-1]]); + outline := outline + value; + end; + OutPutFrm.RichEdit.Lines.Add(outline); + OutPutFrm.RichEdit.Lines.Add(''); + if (last = No_Objects) then done := true + else begin + start := last; + last := start + 10; + end; + end; + outline := format('Coefficient of concordance := %10.3f',[Concordance]); + OutPutFrm.RichEdit.Lines.Add(outline); + outline := format('Average Spearman Rank Correlation := %10.3f',[AvgRankCorr]); + OutPutFrm.RichEdit.Lines.Add(outline); + outline := format('Chi-Square Statistic := %8.3f',[ChiSquare]); + OutPutFrm.RichEdit.Lines.Add(outline); + outline := format('Probability of a larger Chi-Square := %6.4f',[Probability]); + OutPutFrm.RichEdit.Lines.Add(outline); + if (No_Objects < 7) then + OutPutFrm.RichEdit.Lines.Add('Warning - Above Chi-Square is very approximate with 7 or fewer variables!'); + OutPutFrm.ShowModal; + + // cleanup + ColNoSelected := nil; + ColLabels := nil; + ObjRankSums := nil; + temprank := nil; + tempindex := nil; + scorearray := nil; +end; +//------------------------------------------------------------------- + +initialization + {$i concordance.lrs} + {$i CONCORDANCE.lrs} + +end. diff --git a/applications/lazstats/source/not used by LazStats/crosstab.lfm b/applications/lazstats/source/not used by LazStats/crosstab.lfm new file mode 100644 index 000000000..f4f3996f9 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/crosstab.lfm @@ -0,0 +1,145 @@ +object CrossTabFrm: TCrossTabFrm + Left = 320 + Height = 214 + Top = 689 + Width = 521 + HelpContext = 603 + HorzScrollBar.Page = 520 + VertScrollBar.Page = 213 + ActiveControl = VarList + BorderStyle = bsDialog + Caption = 'Cross Tabulation Procedure' + Font.Height = -11 + Font.Name = 'MS Sans Serif' + HelpFile = 'OS2Help.hlp' + OnShow = FormShow + object Label1: TLabel + Left = 16 + Height = 14 + Top = 8 + Width = 94 + Caption = 'Available Variables:' + Color = clNone + ParentColor = False + end + object Label2: TLabel + Left = 184 + Height = 14 + Top = 8 + Width = 102 + Caption = 'Variables to Analyze:' + Color = clNone + ParentColor = False + end + object VarList: TListBox + Left = 8 + Height = 177 + Top = 24 + Width = 129 + ItemHeight = 13 + MultiSelect = True + TabOrder = 0 + end + object InBtn: TBitBtn + Left = 144 + Height = 33 + Top = 32 + Width = 33 + Glyph.Data = { + 76010000424D7601000000000000760000002800000020000000100000000100 + 04000000000000010000120B0000120B00001000000000000000000000000000 + 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3333333333333333333333333333333333333333333333333333333333333333 + 3333333333333333333333333333333333333333333FF3333333333333003333 + 3333333333773FF3333333333309003333333333337F773FF333333333099900 + 33333FFFFF7F33773FF30000000999990033777777733333773F099999999999 + 99007FFFFFFF33333F7700000009999900337777777F333F7733333333099900 + 33333333337F3F77333333333309003333333333337F77333333333333003333 + 3333333333773333333333333333333333333333333333333333333333333333 + 3333333333333333333333333333333333333333333333333333 + } + NumGlyphs = 2 + OnClick = InBtnClick + TabOrder = 1 + end + object OutBtn: TBitBtn + Left = 144 + Height = 33 + Top = 72 + Width = 33 + Enabled = False + Glyph.Data = { + 76010000424D7601000000000000760000002800000020000000100000000100 + 04000000000000010000120B0000120B00001000000000000000000000000000 + 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3333333333333333333333333333333333333333333333333333333333333333 + 3333333333333FF3333333333333003333333333333F77F33333333333009033 + 333333333F7737F333333333009990333333333F773337FFFFFF330099999000 + 00003F773333377777770099999999999990773FF33333FFFFF7330099999000 + 000033773FF33777777733330099903333333333773FF7F33333333333009033 + 33333333337737F3333333333333003333333333333377333333333333333333 + 3333333333333333333333333333333333333333333333333333333333333333 + 3333333333333333333333333333333333333333333333333333 + } + NumGlyphs = 2 + OnClick = OutBtnClick + TabOrder = 2 + end + object ListBox1: TListBox + Left = 184 + Height = 177 + Top = 24 + Width = 137 + ItemHeight = 13 + TabOrder = 3 + end + object ResetBtn: TButton + Left = 448 + Height = 25 + Top = 104 + Width = 65 + BorderSpacing.InnerBorder = 4 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 4 + end + object CancelBtn: TButton + Left = 448 + Height = 25 + Top = 144 + Width = 65 + BorderSpacing.InnerBorder = 4 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 5 + end + object OKBtn: TButton + Left = 447 + Height = 25 + Top = 184 + Width = 65 + BorderSpacing.InnerBorder = 4 + Caption = 'OK' + ModalResult = 1 + OnClick = OKBtnClick + TabOrder = 6 + end + object Memo1: TMemo + Left = 336 + Height = 89 + Top = 8 + Width = 177 + Lines.Strings = ( + 'Directions: Select each categorical' + 'variable from the variables available ' + 'in the leftmost box in the order that ' + 'you wish to have the breakdown' + 'proceed. Click the OK button to ' + 'start the analysis.' + ) + TabOrder = 7 + end +end diff --git a/applications/lazstats/source/not used by LazStats/crosstab.lrs b/applications/lazstats/source/not used by LazStats/crosstab.lrs new file mode 100644 index 000000000..9f7ff947d --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/crosstab.lrs @@ -0,0 +1,53 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TCrossTabFrm','FORMDATA',[ + 'TPF0'#12'TCrossTabFrm'#11'CrossTabFrm'#4'Left'#3'@'#1#6'Height'#3#214#0#3'To' + +'p'#3#177#2#5'Width'#3#9#2#11'HelpContext'#3'['#2#18'HorzScrollBar.Page'#3#8 + +#2#18'VertScrollBar.Page'#3#213#0#13'ActiveControl'#7#7'VarList'#11'BorderSt' + +'yle'#7#8'bsDialog'#7'Caption'#6#26'Cross Tabulation Procedure'#11'Font.Heig' + +'ht'#2#245#9'Font.Name'#6#13'MS Sans Serif'#8'HelpFile'#6#11'OS2Help.hlp'#6 + +'OnShow'#7#8'FormShow'#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#14#3'T' + +'op'#2#8#5'Width'#2'^'#7'Caption'#6#20'Available Variables:'#5'Color'#7#6'cl' + +'None'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#3#184#0#6'Height'#2 + +#14#3'Top'#2#8#5'Width'#2'f'#7'Caption'#6#21'Variables to Analyze:'#5'Color' + +#7#6'clNone'#11'ParentColor'#8#0#0#8'TListBox'#7'VarList'#4'Left'#2#8#6'Heig' + +'ht'#3#177#0#3'Top'#2#24#5'Width'#3#129#0#10'ItemHeight'#2#13#11'MultiSelect' + +#9#8'TabOrder'#2#0#0#0#7'TBitBtn'#5'InBtn'#4'Left'#3#144#0#6'Height'#2'!'#3 + +'Top'#2' '#5'Width'#2'!'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0 + +#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#18#11#0#0#18 + +#11#0#0#16#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0 + +#128#0#128#0#128#128#0#0''#0#191#191#191#0#0#0#255#0#0#255#0#0#0#255#255#0 + +#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0'333333333333333333333333333' + +'33333333333333333333333333333333?'#243'333333'#0'3333333w?'#243'33333'#9#0 + +'333333w?'#243'3333'#9#153#0'33?'#255#255'3w?'#243#0#0#0#9#153#153#0'3wwws' + +'33w?'#9#153#153#153#153#153#153#0''#255#255#255'33?w'#0#0#0#9#153#153#0'3w' + +'ww3?w3333'#9#153#0'33333?w33333'#9#0'333333w333333'#0'3333333w3333333333' + +'333333333333333333333333333333333333333333'#9'NumGlyphs'#2#2#7'OnClick'#7#10 + +'InBtnClick'#8'TabOrder'#2#1#0#0#7'TBitBtn'#6'OutBtn'#4'Left'#3#144#0#6'Heig' + +'ht'#2'!'#3'Top'#2'H'#5'Width'#2'!'#7'Enabled'#8#10'Glyph.Data'#10'z'#1#0#0 + +'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0 + +#0#0#0#1#0#0#18#11#0#0#18#11#0#0#16#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0 + +#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0''#0#191#191#191#0#0#0#255#0 + +#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0'33333' + +'333333333333333333333333333333333333333?'#243'333333'#0'333333?w'#243'33333' + +#0#144'33333?w7'#243'3333'#0#153#144'3333?w37'#255#255#255'3'#0#153#153#144#0 + +#0#0'?w337www'#0#153#153#153#153#153#153#144'w?'#243'33'#255#255#247'3'#0#153 + +#153#144#0#0#0'3w?'#243'7www33'#0#153#144'33333w?'#247#243'33333'#0#144'3333' + +'33w7'#243'333333'#0'3333333w33333333333333333333333333333333333333333333333' + +'33333333333333333333'#9'NumGlyphs'#2#2#7'OnClick'#7#11'OutBtnClick'#8'TabOr' + +'der'#2#2#0#0#8'TListBox'#8'ListBox1'#4'Left'#3#184#0#6'Height'#3#177#0#3'To' + +'p'#2#24#5'Width'#3#137#0#10'ItemHeight'#2#13#8'TabOrder'#2#3#0#0#7'TButton' + +#8'ResetBtn'#4'Left'#3#192#1#6'Height'#2#25#3'Top'#2'h'#5'Width'#2'A'#25'Bor' + +'derSpacing.InnerBorder'#2#4#7'Caption'#6#5'Reset'#7'OnClick'#7#13'ResetBtnC' + +'lick'#8'TabOrder'#2#4#0#0#7'TButton'#9'CancelBtn'#4'Left'#3#192#1#6'Height' + +#2#25#3'Top'#3#144#0#5'Width'#2'A'#25'BorderSpacing.InnerBorder'#2#4#7'Capti' + +'on'#6#6'Cancel'#11'ModalResult'#2#2#7'OnClick'#7#14'CancelBtnClick'#8'TabOr' + +'der'#2#5#0#0#7'TButton'#5'OKBtn'#4'Left'#3#191#1#6'Height'#2#25#3'Top'#3#184 + +#0#5'Width'#2'A'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#2'OK'#11'Mod' + +'alResult'#2#1#7'OnClick'#7#10'OKBtnClick'#8'TabOrder'#2#6#0#0#5'TMemo'#5'Me' + +'mo1'#4'Left'#3'P'#1#6'Height'#2'Y'#3'Top'#2#8#5'Width'#3#177#0#13'Lines.Str' + +'ings'#1#6'$Directions: Select each categorical'#6'&variable from the varia' + +'bles available '#6'&in the leftmost box in the order that '#6#30'you wish t' + +'o have the breakdown'#6'!proceed. Click the OK button to '#6#19'start the ' + +'analysis.'#0#8'TabOrder'#2#7#0#0#0 +]); diff --git a/applications/lazstats/source/not used by LazStats/crosstab.pas b/applications/lazstats/source/not used by LazStats/crosstab.pas new file mode 100644 index 000000000..973310519 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/crosstab.pas @@ -0,0 +1,378 @@ +unit CrossTab; + +{$MODE Delphi} + +interface + +uses + LCLIntf, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Buttons, GLOBALS, OUTPUTUNIT, OS3MainUnit, DATAPROCS, FUNCTIONSLIB, + MATRIXLIB, LResources; + +type + TCrossTabFrm = class(TForm) + Label1: TLabel; + VarList: TListBox; + InBtn: TBitBtn; + OutBtn: TBitBtn; + Label2: TLabel; + ListBox1: TListBox; + ResetBtn: TButton; + CancelBtn: TButton; + OKBtn: TButton; + Memo1: TMemo; + procedure ResetBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure CancelBtnClick(Sender: TObject); + procedure OKBtnClick(Sender: TObject); + procedure InBtnClick(Sender: TObject); + procedure OutBtnClick(Sender: TObject); + private + { Private declarations } + grandsum, sum, index : integer; + no_in_list, length_array, ptr1, ptr2 : integer ; + var_list, min_value, max_value, levels, displace, subscript : IntDyneVec; + freq : IntDyneVec; + outgrid : DblDyneMat; + rowlabels : StrDyneVec; + colLabels : StrDyneVec; + ColNoSelected : IntDyneVec; + NoSelected : integer; + NV, NC : integer; + + procedure INITIALIZE(Sender: TObject); + procedure GET_Levels(Sender: TObject); + function INDEX_POSITION( x : IntDyneVec; Sender: TObject ) : integer; + Procedure TABULATE(Sender : TObject); + procedure BREAKDOWN(Sender : TObject); + + public + { Public declarations } + end; + +var + CrossTabFrm: TCrossTabFrm; + +implementation + + +procedure TCrossTabFrm.ResetBtnClick(Sender: TObject); +var + i : integer; + +begin + VarList.Clear; + ListBox1.Clear; + OutBtn.Enabled := false; + InBtn.Enabled := true; + NV := NoVariables; + NC := NoCases; + for i := 1 to NV do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); +end; +//---------------------------------------------------------------------- + +procedure TCrossTabFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; +//---------------------------------------------------------------------- + +procedure TCrossTabFrm.CancelBtnClick(Sender: TObject); +begin + CrossTabFrm.Hide; +end; +//---------------------------------------------------------------------- + +procedure TCrossTabFrm.OKBtnClick(Sender: TObject); +label CleanUp; +var + cellvalue : string; + i, j : integer; + outline : string; +begin + SetLength(var_list,NV); + SetLength(min_value,NV); + SetLength(max_value,NV); + SetLength(levels,NC); + SetLength(displace,NC); + SetLength(subscript,NC); + SetLength(ColNoSelected,NV); + + OutPutFrm.RichEdit.Clear; +// OutPutFrm.RichEdit.ParaGraph.Alignment := taLeftJustify; + OutPutFrm.RichEdit.Lines.Add('CROSSTAB RESULTS'); + OutPutFrm.RichEdit.Lines.Add(''); + outline := ' Analyzed data is from file : '; + outline := outline + OS3MainFrm.FileNameEdit.Text; + OutPutFrm.RichEdit.Lines.Add(outline); + OutPutFrm.RichEdit.Lines.Add(''); + INITIALIZE(self); + if ListBox1.Items.Count = 0 then + begin + ShowMessage('ERROR! No variables selected for analysis.'); + goto CleanUp; + end; + + NoSelected := 0; + for i := 0 to ListBox1.Items.Count-1 do + begin + for j := 1 to NV do + begin + cellvalue := OS3MainFrm.DataGrid.Cells[j,0]; + if cellvalue = ListBox1.Items.Strings[i] then + begin + var_list[i] := j; + ColNoSelected[i] := j; + NoSelected := NoSelected + 1; + break; + end; + end; + end; + no_in_list := ListBox1.Items.Count; + GET_LEVELS(self); + TABULATE(self); + BREAKDOWN(self); + OutPutFrm.RichEdit.Lines.Add(''); + cellvalue := format('Grand sum accross all categories = %3d',[grandsum]); + OutPutFrm.RichEdit.Lines.Add(cellvalue); + OutPutFrm.ShowModal; + +CleanUp: + ColNoSelected := nil; + freq := nil; + collabels := nil; + rowlabels := nil; + outgrid := nil; + subscript := nil; + displace := nil; + levels := nil; + max_value := nil; + min_value := nil; + var_list := nil; + CrossTabFrm.Hide; +end; +//--------------------------------------------------------------------- + +procedure TCrossTabFrm.InBtnClick(Sender: TObject); +var + index, i : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + ListBox1.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + OutBtn.Enabled := true; +end; +//----------------------------------------------------------------------- + +procedure TCrossTabFrm.OutBtnClick(Sender: TObject); +var + index: integer; +begin + index := ListBox1.ItemIndex; + VarList.Items.Add(ListBox1.Items.Strings[index]); + ListBox1.Items.Delete(index); + InBtn.Enabled := true; + if ListBox1.Items.Count = 0 then OutBtn.Enabled := false; +end; +//----------------------------------------------------------------------- + +procedure TCrossTabFrm.INITIALIZE(Sender: TObject); +var + i : integer; + +begin + no_in_list := 0; + for i := 1 to NV do + begin + var_list[i-1] := 0; + min_value[i-1] := 0; + max_value[i-1] := 0; + levels[i-1] := 0; + displace[i-1] := 0; + subscript[i-1] := 0; + end; + index := 0; + length_array := 0; + grandsum := 0; +end; { initialize procedure } +//----------------------------------------------------------------------- + +procedure TCrossTabFrm.GET_Levels(Sender: TObject); +var + i, j, k : integer; + value : double; + outline : string; + +begin + for i := 1 to no_in_list do + begin + j := var_list[i-1]; + if Not GoodRecord(1,NoSelected,ColNoSelected) then continue; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[j,1]); + min_value[i-1] := round(value); + max_value[i-1] := round(value); + for k := 2 to NC do + begin + if Not GoodRecord(k,NoSelected,ColNoSelected) then continue; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[j,k]); + if value < min_value[i-1] then min_value[i-1] := + round(value); + if value > max_value[i-1] then max_value[i-1] := + round(value); + end; + end; + for i := 1 to no_in_list do + begin + j := var_list[i-1]; + levels[i-1] := max_value[i-1] - min_value[i-1] + 1; + outline := format('%s min.=%3d, max.=%3d, no. levels = %3d', + [OS3MainFrm.DataGrid.Cells[j,0],min_value[i-1],max_value[i-1],levels[i-1]]); + OutPutFrm.RichEdit.Lines.Add(outline); + end; + OutPutFrm.RichEdit.Lines.Add(''); + displace[no_in_list-1] := 1; + if no_in_list > 1 then + begin + for i := (no_in_list - 1) downto 1 do + displace[i-1] := levels[i] * displace[i]; + end; +end; +//----------------------------------------------------------------------- +function TCrossTabFrm.INDEX_POSITION( x : IntDyneVec; Sender: TObject ) : integer; + +var index : integer; + i : integer; + +begin + index := x[no_in_list-1]; + if no_in_list > 1 then + begin + for i := 1 to no_in_list - 1 do + index := index + (x[i-1] -1) * displace[i-1]; + end; + index_position := index; +end; { function INDEX_POSITION } +//------------------------------------------------------------------------ +Procedure TCrossTabFrm.TABULATE(Sender : TObject); +var + i, j, k : integer; + value : double; + x : integer; +begin + length_array := 1; + for i := 1 to no_in_list do length_array := length_array * levels[i-1]; + SetLength(freq,length_array+1); + for i := 0 to length_array do freq[i] := 0; + for i := 1 to NC do + begin + if IsFiltered(i) then continue; + for j := 1 to no_in_list do + begin + if Not GoodRecord(i,NoSelected,ColNoSelected) then continue; + k := var_list[j-1]; + value := StrToFloat(OS3MainFrm.DataGrid.Cells[k,i]); + x := round(value); + x := x - min_value[j-1] + 1; + subscript[j-1] := x; + end; + j := index_position(subscript,self); + + if (j < 1) or (j > length_array) then + begin + ShowMessage('ERROR! subscript out of range.'); + continue; + end + else freq[j] := freq[j] + 1; + end; +end; { procedure TABULATE } +//--------------------------------------------------------------------- +procedure TCrossTabFrm.BREAKDOWN(Sender : TObject); + +label 1,2,3,4, printgrid; +var + i, j, row, col, bigmax : integer; + outline : string; + value : string; + title : String; +begin + bigmax := -1; + for i := 0 to no_in_list-1 do + if Levels[i] > bigmax then bigmax := Levels[i]; + SetLength(colLabels,bigmax); + SetLength(outgrid,length_array,bigmax); + SetLength(rowlabels,length_array); + outline := OS3MainFrm.DataGrid.Cells[var_list[no_in_list-1],0]; + for col := 1 to Levels[no_in_list-1] do + collabels[col-1] := outline + format(':%3d',[min_value[no_in_list-1] + col - 1]); + for row := 1 to length_array do rowlabels[row-1] := ''; + ptr1 := no_in_list - 1; + ptr2 := no_in_list; + for i := 1 to no_in_list do subscript[i-1] := 1; + OutPutFrm.RichEdit.Lines.Add('FREQUENCIES BY LEVEL:'); + sum := 0; + col := 1; + row := 1; + 1: index := index_position(subscript,self); + outline := 'For cell levels: '; + for i := 1 to no_in_list do + begin + j := var_list[i-1]; + value := format('%s:%3d ',[OS3MainFrm.DataGrid.Cells[j,0], + min_value[i-1] + subscript[i-1] - 1]); + outline := outline + value; + end; + sum := sum + freq[index]; + outgrid[row-1,col-1] := freq[index]; + outline := outline + format(' Frequency = %3d',[freq[index]]); + OutPutFrm.RichEdit.Lines.Add(outline); + subscript[ptr2-1] := subscript[ptr2-1] + 1; + col := col + 1; + IF subscript[ptr2-1] <= levels[ptr2-1] then goto 1; + outline := format('Sum accross levels = %3d',[sum]); + OutPutFrm.RichEdit.Lines.Add(outline); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add(''); + grandsum := grandsum + sum; + sum := 0; + row := row + 1; + 2: if ptr1 < 1 then goto printgrid; + subscript[ptr1-1] := subscript[ptr1-1] + 1; + if subscript[ptr1-1] <= levels[ptr1-1] then goto 4; + 3: ptr1 := ptr1 - 1; + if ptr1 < 1 then goto printgrid; + if subscript[ptr1-1] >= levels[ptr1-1] then goto 3; + subscript[ptr1-1] := subscript[ptr1-1] + 1; + 4: for i := ptr1 + 1 to no_in_list do subscript[i-1] := 1; + ptr1 := no_in_list - 1; + col := 1; + goto 1; + +printgrid: + title := 'Cell Frequencies by Levels'; + for i := 1 to row - 1 do + begin + value := format('Block %d',[i]); + rowlabels[i-1] := value; + end; + MAT_PRINT(outgrid,row-1,Levels[no_in_list-1],title,rowlabels,collabels,NC); + +end; { Procedure BREAKDOWN } +//--------------------------------------------------------------------- + + +initialization + {$i CROSSTAB.lrs} + {$i CROSSTAB.lrs} + +end. diff --git a/applications/lazstats/source/not used by LazStats/dataunit.pas b/applications/lazstats/source/not used by LazStats/dataunit.pas new file mode 100644 index 000000000..569d2d333 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/dataunit.pas @@ -0,0 +1,72 @@ +unit DataUnit; + +interface + +uses + //Windows, Messages, + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, Grids, OutPutUnit, Globals; + +procedure GetFileData(VAR FName : string); +procedure Allocations; +procedure DeAllocations; + +implementation + +uses LinPro; + +procedure GetFileData(VAR FName : string); + +var + F : TextFile; + i, j : integer; + +begin + LinProFrm.OpenDialog1.DefaultExt := 'LPR'; + LinProFrm.OpenDialog1.Filter := 'Linear Programming File (*.LPR)|*.LPR|All Files (*.*)|*.*'; + LinProFrm.OpenDialog1.FilterIndex := 1; + if LinProFrm.OpenDialog1.Execute then + begin + FName := LinProFrm.OpenDialog1.FileName; + AssignFile(F,FName); + Reset(F); + readln(F,LinProFrm.NoVars); + readln(F,LinProFrm.NoMax); + readln(F,LinProFrm.NoMin); + readln(F,LinProFrm.NoEql); + readln(F,LinProFrm.MinMax); + LinProFrm.NoCoefs := LinProFrm.NoMax + LinProFrm.NoMin + LinProFrm.NoEql; + Alloc; + for i := 1 to LinProFrm.NoVars do readln(F,LinProFrm.Objective[i]); + for i := 1 to LinProFrm.NoMax do readln(F,LinProFrm.MaxConstraints[i]); + for i := 1 to LinProFrm.NoMin do readln(F,LinProFrm.MinConstraints[i]); + for i := 1 to LinProFrm.NoEql do readln(F,LinProFrm.EqlConstraints[i]); + for i := 1 to LinProFrm.NoCoefs do + for j := 1 to LinProFrm.NoVars do readln(F,LinProFrm.Coefficients[i,j]); + CloseFile(F); + end; +end; +//------------------------------------------------------------------- + +procedure Allocations; +begin + SetLength(LinProFrm.Objective,LinProFrm.NoVars + 1); + SetLength(LinProFrm.MaxConstraints,LinProFrm.NoMax + 1); + SetLength(LinProFrm.MinConstraints,LinProFrm.NoMin + 1); + SetLength(LinProFrm.EqlConstraints,LinProFrm.NoEql+1); + SetLength(LinProFrm.Coefficients,LinProFrm.NoCoefs+1,LinProFrm.NoVars+1); +end; +//------------------------------------------------------------------- + +procedure DeAllocations; +begin + // cleanup + LinProFrm.Coefficients := nil; + LinProFrm.EqlConstraints := nil; + LinProFrm.MinConstraints := nil; + LinProFrm.MaxConstraints := nil; + LinProFrm.Objective := nil; +end; +//------------------------------------------------------------------- + +end. diff --git a/applications/lazstats/source/not used by LazStats/dif.lfm b/applications/lazstats/source/not used by LazStats/dif.lfm new file mode 100644 index 000000000..2f2582286 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/dif.lfm @@ -0,0 +1,422 @@ +object DIFfrm: TDIFfrm + Left = 62 + Top = 100 + Width = 486 + Height = 466 + HelpContext = 1210 + Caption = 'DIF Specifications' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + HelpFile = 'OS2Help.hlp' + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 8 + Top = 112 + Width = 89 + Height = 13 + Caption = 'Available Variables' + end + object Label2: TLabel + Left = 200 + Top = 112 + Width = 70 + Height = 13 + Caption = 'Items Selected' + end + object Label3: TLabel + Left = 200 + Top = 264 + Width = 84 + Height = 13 + Caption = 'Grouping Variable' + end + object Label4: TLabel + Left = 200 + Top = 328 + Width = 110 + Height = 13 + Caption = 'Reference group code:' + end + object Label5: TLabel + Left = 200 + Top = 352 + Width = 89 + Height = 13 + Caption = 'Focal Group Code:' + end + object Label6: TLabel + Left = 200 + Top = 376 + Width = 94 + Height = 13 + Caption = 'No. of Score Levels' + end + object Label7: TLabel + Left = 352 + Top = 288 + Width = 108 + Height = 13 + Caption = 'Enter bounds for levels' + end + object Label8: TLabel + Left = 352 + Top = 352 + Width = 66 + Height = 13 + Caption = 'Lower Bound:' + end + object Label9: TLabel + Left = 352 + Top = 376 + Width = 66 + Height = 13 + Caption = 'Upper Bound:' + end + object Label10: TLabel + Left = 352 + Top = 304 + Width = 28 + Height = 13 + Caption = 'Down' + end + object Label11: TLabel + Left = 416 + Top = 304 + Width = 14 + Height = 13 + Caption = 'Up' + end + object Label12: TLabel + Left = 440 + Top = 304 + Width = 26 + Height = 13 + Caption = 'Level' + end + object Memo1: TMemo + Left = 8 + Top = 0 + Width = 457 + Height = 105 + Lines.Strings = ( + + 'This procedure is an adaptation of the program written by Niels ' + + 'G. Waller, Dept. of Psychology,' + + 'University of California - Davis, Jan. 1998. It'#39's purpose is to' + + ' identify test items that differ in the ' + + 'response pattern for two groups: a reference group and a focal g' + + 'roup. The file of data to be ' + + 'analyzed should consist of a variable containing a code designat' + + 'ing the two groups and ' + + 'variables containing subject'#39's item responses coded 0 for incorr' + + 'ect and 1 for correct. No ' + + 'missing data may be included. The results provide the Mantel-Ha' + + 'enszel statistics for identifying ' + 'those items which are different for the two groups.') + TabOrder = 0 + end + object VarList: TListBox + Left = 8 + Top = 128 + Width = 137 + Height = 249 + ItemHeight = 13 + MultiSelect = True + TabOrder = 1 + end + object ItemInBtn: TBitBtn + Left = 160 + Top = 152 + Width = 25 + Height = 25 + TabOrder = 2 + OnClick = ItemInBtnClick + Glyph.Data = { + 76010000424D7601000000000000760000002800000020000000100000000100 + 04000000000000010000120B0000120B00001000000000000000000000000000 + 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3333333333333333333333333333333333333333333333333333333333333333 + 3333333333333333333333333333333333333333333FF3333333333333003333 + 3333333333773FF3333333333309003333333333337F773FF333333333099900 + 33333FFFFF7F33773FF30000000999990033777777733333773F099999999999 + 99007FFFFFFF33333F7700000009999900337777777F333F7733333333099900 + 33333333337F3F77333333333309003333333333337F77333333333333003333 + 3333333333773333333333333333333333333333333333333333333333333333 + 3333333333333333333333333333333333333333333333333333} + NumGlyphs = 2 + end + object ItemOutBtn: TBitBtn + Left = 160 + Top = 184 + Width = 25 + Height = 25 + TabOrder = 3 + OnClick = ItemOutBtnClick + Glyph.Data = { + 76010000424D7601000000000000760000002800000020000000100000000100 + 04000000000000010000120B0000120B00001000000000000000000000000000 + 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3333333333333333333333333333333333333333333333333333333333333333 + 3333333333333FF3333333333333003333333333333F77F33333333333009033 + 333333333F7737F333333333009990333333333F773337FFFFFF330099999000 + 00003F773333377777770099999999999990773FF33333FFFFF7330099999000 + 000033773FF33777777733330099903333333333773FF7F33333333333009033 + 33333333337737F3333333333333003333333333333377333333333333333333 + 3333333333333333333333333333333333333333333333333333333333333333 + 3333333333333333333333333333333333333333333333333333} + NumGlyphs = 2 + end + object AllBtn: TBitBtn + Left = 160 + Top = 216 + Width = 25 + Height = 25 + Caption = 'ALL' + TabOrder = 4 + OnClick = AllBtnClick + end + object GrpInBtn: TBitBtn + Left = 160 + Top = 264 + Width = 25 + Height = 25 + TabOrder = 5 + OnClick = GrpInBtnClick + Glyph.Data = { + 76010000424D7601000000000000760000002800000020000000100000000100 + 04000000000000010000120B0000120B00001000000000000000000000000000 + 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3333333333333333333333333333333333333333333333333333333333333333 + 3333333333333333333333333333333333333333333FF3333333333333003333 + 3333333333773FF3333333333309003333333333337F773FF333333333099900 + 33333FFFFF7F33773FF30000000999990033777777733333773F099999999999 + 99007FFFFFFF33333F7700000009999900337777777F333F7733333333099900 + 33333333337F3F77333333333309003333333333337F77333333333333003333 + 3333333333773333333333333333333333333333333333333333333333333333 + 3333333333333333333333333333333333333333333333333333} + NumGlyphs = 2 + end + object GrpOutBtn: TBitBtn + Left = 160 + Top = 296 + Width = 25 + Height = 25 + TabOrder = 6 + Glyph.Data = { + 76010000424D7601000000000000760000002800000020000000100000000100 + 04000000000000010000120B0000120B00001000000000000000000000000000 + 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3333333333333333333333333333333333333333333333333333333333333333 + 3333333333333FF3333333333333003333333333333F77F33333333333009033 + 333333333F7737F333333333009990333333333F773337FFFFFF330099999000 + 00003F773333377777770099999999999990773FF33333FFFFF7330099999000 + 000033773FF33777777733330099903333333333773FF7F33333333333009033 + 33333333337737F3333333333333003333333333333377333333333333333333 + 3333333333333333333333333333333333333333333333333333333333333333 + 3333333333333333333333333333333333333333333333333333} + NumGlyphs = 2 + end + object GroupVarEdit: TEdit + Left = 200 + Top = 280 + Width = 137 + Height = 21 + TabOrder = 7 + Text = 'GroupVarEdit' + end + object ItemsList: TListBox + Left = 200 + Top = 128 + Width = 137 + Height = 121 + ItemHeight = 13 + TabOrder = 8 + end + object RefGrpEdit: TEdit + Left = 312 + Top = 320 + Width = 25 + Height = 21 + TabOrder = 9 + Text = 'RefGrpEdit' + end + object TrgtGrpEdit: TEdit + Left = 312 + Top = 344 + Width = 25 + Height = 21 + TabOrder = 10 + Text = 'TrgtGrpEdit' + end + object ResetBtn: TButton + Left = 8 + Top = 408 + Width = 65 + Height = 25 + Caption = 'Reset' + TabOrder = 11 + OnClick = ResetBtnClick + end + object ComputeBtn: TButton + Left = 208 + Top = 408 + Width = 65 + Height = 25 + Caption = 'Compute' + TabOrder = 12 + OnClick = ComputeBtnClick + end + object ReturnBtn: TButton + Left = 400 + Top = 408 + Width = 65 + Height = 25 + Caption = 'Return' + ModalResult = 1 + TabOrder = 13 + OnClick = ReturnBtnClick + end + object GroupBox1: TGroupBox + Left = 352 + Top = 112 + Width = 113 + Height = 169 + Caption = 'Options' + TabOrder = 14 + object ItemStatsChk: TCheckBox + Left = 8 + Top = 16 + Width = 89 + Height = 17 + Caption = 'Item Statistics' + Checked = True + State = cbChecked + TabOrder = 0 + end + object TestStatsChk: TCheckBox + Left = 8 + Top = 32 + Width = 89 + Height = 17 + Caption = 'Test Statistics' + TabOrder = 1 + end + object ItemCorrsChk: TCheckBox + Left = 8 + Top = 48 + Width = 97 + Height = 17 + Caption = 'Item Intercorr.s' + TabOrder = 2 + end + object ItemTestChk: TCheckBox + Left = 8 + Top = 64 + Width = 89 + Height = 17 + Caption = 'Item-Test cor.s' + TabOrder = 3 + end + object AlphaChk: TCheckBox + Left = 8 + Top = 80 + Width = 97 + Height = 17 + Caption = 'Alpha Reliability' + TabOrder = 4 + end + object LogisticChk: TCheckBox + Left = 8 + Top = 112 + Width = 97 + Height = 17 + Caption = 'Logistic Regres.' + Enabled = False + TabOrder = 5 + end + object MHChk: TCheckBox + Left = 8 + Top = 96 + Width = 97 + Height = 17 + Caption = 'Mantel-Haenszel' + Checked = True + State = cbChecked + TabOrder = 6 + end + object CurvesChk: TCheckBox + Left = 8 + Top = 128 + Width = 97 + Height = 17 + Caption = 'Item Char. Crvs.' + TabOrder = 7 + end + object CountsChk: TCheckBox + Left = 8 + Top = 144 + Width = 97 + Height = 17 + Caption = 'Level Counts' + TabOrder = 8 + end + end + object LevelsEdit: TEdit + Left = 312 + Top = 368 + Width = 25 + Height = 21 + TabOrder = 15 + OnExit = LevelsEditExit + end + object LevelNoEdit: TEdit + Left = 440 + Top = 320 + Width = 25 + Height = 21 + TabOrder = 16 + Text = '1' + end + object LowBoundEdit: TEdit + Left = 440 + Top = 344 + Width = 25 + Height = 21 + TabOrder = 17 + OnExit = LowBoundEditExit + end + object UpBoundEdit: TEdit + Left = 440 + Top = 368 + Width = 25 + Height = 21 + TabOrder = 18 + OnExit = UpBoundEditExit + end + object LevelScroll: TScrollBar + Left = 352 + Top = 320 + Width = 81 + Height = 19 + Min = 1 + PageSize = 0 + Position = 1 + TabOrder = 19 + OnScroll = LevelScrollScroll + end +end diff --git a/applications/lazstats/source/not used by LazStats/dif.lrs b/applications/lazstats/source/not used by LazStats/dif.lrs new file mode 100644 index 000000000..fe521de37 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/dif.lrs @@ -0,0 +1,127 @@ +LazarusResources.Add('TDIFfrm','FORMDATA',[ + 'TPF0'#7'TDIFfrm'#6'DIFfrm'#4'Left'#2'>'#3'Top'#2'd'#5'Width'#3#230#1#6'Heigh' + +'t'#3#210#1#11'HelpContext'#3#186#4#7'Caption'#6#18'DIF Specifications'#5'Co' + +'lor'#7#9'clBtnFace'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7 + +#12'clWindowText'#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#10 + +'Font.Style'#11#0#8'HelpFile'#6#11'OS2Help.hlp'#6'OnShow'#7#8'FormShow'#13'P' + +'ixelsPerInch'#2'`'#10'TextHeight'#2#13#0#6'TLabel'#6'Label1'#4'Left'#2#8#3 + +'Top'#2'p'#5'Width'#2'Y'#6'Height'#2#13#7'Caption'#6#19'Available Variables' + +#0#0#6'TLabel'#6'Label2'#4'Left'#3#200#0#3'Top'#2'p'#5'Width'#2'F'#6'Height' + +#2#13#7'Caption'#6#14'Items Selected'#0#0#6'TLabel'#6'Label3'#4'Left'#3#200#0 + +#3'Top'#3#8#1#5'Width'#2'T'#6'Height'#2#13#7'Caption'#6#17'Grouping Variable' + +#0#0#6'TLabel'#6'Label4'#4'Left'#3#200#0#3'Top'#3'H'#1#5'Width'#2'n'#6'Heigh' + +'t'#2#13#7'Caption'#6#21'Reference group code:'#0#0#6'TLabel'#6'Label5'#4'Le' + +'ft'#3#200#0#3'Top'#3'`'#1#5'Width'#2'Y'#6'Height'#2#13#7'Caption'#6#17'Foca' + +'l Group Code:'#0#0#6'TLabel'#6'Label6'#4'Left'#3#200#0#3'Top'#3'x'#1#5'Widt' + +'h'#2'^'#6'Height'#2#13#7'Caption'#6#19'No. of Score Levels'#0#0#6'TLabel'#6 + +'Label7'#4'Left'#3'`'#1#3'Top'#3' '#1#5'Width'#2'l'#6'Height'#2#13#7'Caption' + +#6#23'Enter bounds for levels'#0#0#6'TLabel'#6'Label8'#4'Left'#3'`'#1#3'Top' + +#3'`'#1#5'Width'#2'B'#6'Height'#2#13#7'Caption'#6#12'Lower Bound:'#0#0#6'TLa' + +'bel'#6'Label9'#4'Left'#3'`'#1#3'Top'#3'x'#1#5'Width'#2'B'#6'Height'#2#13#7 + +'Caption'#6#12'Upper Bound:'#0#0#6'TLabel'#7'Label10'#4'Left'#3'`'#1#3'Top'#3 + +'0'#1#5'Width'#2#28#6'Height'#2#13#7'Caption'#6#4'Down'#0#0#6'TLabel'#7'Labe' + +'l11'#4'Left'#3#160#1#3'Top'#3'0'#1#5'Width'#2#14#6'Height'#2#13#7'Caption'#6 + +#2'Up'#0#0#6'TLabel'#7'Label12'#4'Left'#3#184#1#3'Top'#3'0'#1#5'Width'#2#26#6 + +'Height'#2#13#7'Caption'#6#5'Level'#0#0#5'TMemo'#5'Memo1'#4'Left'#2#8#3'Top' + +#2#0#5'Width'#3#201#1#6'Height'#2'i'#13'Lines.Strings'#1#6'_This procedure i' + +'s an adaptation of the program written by Niels G. Waller, Dept. of Psychol' + +'ogy,'#6'hUniversity of California - Davis, Jan. 1998. It''s purpose is to ' + +'identify test items that differ in the '#6'^response pattern for two groups' + +': a reference group and a focal group. The file of data to be '#6'Wanalyze' + +'d should consist of a variable containing a code designating the two groups' + +' and '#6'[variables containing subject''s item responses coded 0 for incorr' + +'ect and 1 for correct. No '#6'bmissing data may be included. The results ' + +'provide the Mantel-Haenszel statistics for identifying '#6'3those items whi' + +'ch are different for the two groups.'#0#8'TabOrder'#2#0#0#0#8'TListBox'#7'V' + +'arList'#4'Left'#2#8#3'Top'#3#128#0#5'Width'#3#137#0#6'Height'#3#249#0#10'It' + +'emHeight'#2#13#11'MultiSelect'#9#8'TabOrder'#2#1#0#0#7'TBitBtn'#9'ItemInBtn' + +#4'Left'#3#160#0#3'Top'#3#152#0#5'Width'#2#25#6'Height'#2#25#8'TabOrder'#2#2 + +#7'OnClick'#7#14'ItemInBtnClick'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0 + +#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#18#11 + +#0#0#18#11#0#0#16#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0 + +#0#0#128#0#128#0#128#128#0#0''#0#191#191#191#0#0#0#255#0#0#255#0#0#0#255 + +#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0'333333333333333333333' + +'33333333333333333333333333333333333333?'#243'333333'#0'3333333w?'#243'33333' + +#9#0'333333w?'#243'3333'#9#153#0'33?'#255#255'3w?'#243#0#0#0#9#153#153#0'3' + +'wwws33w?'#9#153#153#153#153#153#153#0''#255#255#255'33?w'#0#0#0#9#153#153#0 + +'3www3?w3333'#9#153#0'33333?w33333'#9#0'333333w333333'#0'3333333w33333333' + +'33333333333333333333333333333333333333333333'#9'NumGlyphs'#2#2#0#0#7'TBitBt' + +'n'#10'ItemOutBtn'#4'Left'#3#160#0#3'Top'#3#184#0#5'Width'#2#25#6'Height'#2 + +#25#8'TabOrder'#2#3#7'OnClick'#7#15'ItemOutBtnClick'#10'Glyph.Data'#10'z'#1#0 + +#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0 + +#0#0#0#0#1#0#0#18#11#0#0#18#11#0#0#16#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0 + +#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0''#0#191#191#191#0#0#0#255 + +#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0'333' + +'33333333333333333333333333333333333333333?'#243'333333'#0'333333?w'#243'333' + +'33'#0#144'33333?w7'#243'3333'#0#153#144'3333?w37'#255#255#255'3'#0#153#153 + +#144#0#0#0'?w337www'#0#153#153#153#153#153#153#144'w?'#243'33'#255#255#247'3' + +#0#153#153#144#0#0#0'3w?'#243'7www33'#0#153#144'33333w?'#247#243'33333'#0#144 + +'333333w7'#243'333333'#0'3333333w3333333333333333333333333333333333333333333' + +'333333333333333333333333'#9'NumGlyphs'#2#2#0#0#7'TBitBtn'#6'AllBtn'#4'Left' + +#3#160#0#3'Top'#3#216#0#5'Width'#2#25#6'Height'#2#25#7'Caption'#6#3'ALL'#8'T' + +'abOrder'#2#4#7'OnClick'#7#11'AllBtnClick'#0#0#7'TBitBtn'#8'GrpInBtn'#4'Left' + +#3#160#0#3'Top'#3#8#1#5'Width'#2#25#6'Height'#2#25#8'TabOrder'#2#5#7'OnClick' + +#7#13'GrpInBtnClick'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0 + +'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#18#11#0#0#18#11 + ,#0#0#16#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0 + +#128#0#128#128#0#0''#0#191#191#191#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0 + +#0#0#255#0#255#0#255#255#0#0#255#255#255#0'333333333333333333333333333333333' + +'33333333333333333333333333?'#243'333333'#0'3333333w?'#243'33333'#9#0'333333' + +'w?'#243'3333'#9#153#0'33?'#255#255'3w?'#243#0#0#0#9#153#153#0'3wwws33w?'#9 + +#153#153#153#153#153#153#0''#255#255#255'33?w'#0#0#0#9#153#153#0'3www3?w33' + +'33'#9#153#0'33333?w33333'#9#0'333333w333333'#0'3333333w333333333333333333' + +'3333333333333333333333333333333333'#9'NumGlyphs'#2#2#0#0#7'TBitBtn'#9'GrpOu' + +'tBtn'#4'Left'#3#160#0#3'Top'#3'('#1#5'Width'#2#25#6'Height'#2#25#8'TabOrder' + +#2#6#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0 + +' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#18#11#0#0#18#11#0#0#16#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0 + +''#0#191#191#191#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0 + +#255#255#0#0#255#255#255#0'33333333333333333333333333333333333333333333?'#243 + +'333333'#0'333333?w'#243'33333'#0#144'33333?w7'#243'3333'#0#153#144'3333?w37' + +#255#255#255'3'#0#153#153#144#0#0#0'?w337www'#0#153#153#153#153#153#153#144 + +'w?'#243'33'#255#255#247'3'#0#153#153#144#0#0#0'3w?'#243'7www33'#0#153#144'3' + +'3333w?'#247#243'33333'#0#144'333333w7'#243'333333'#0'3333333w33333333333333' + +'33333333333333333333333333333333333333333333333333333'#9'NumGlyphs'#2#2#0#0 + +#5'TEdit'#12'GroupVarEdit'#4'Left'#3#200#0#3'Top'#3#24#1#5'Width'#3#137#0#6 + +'Height'#2#21#8'TabOrder'#2#7#4'Text'#6#12'GroupVarEdit'#0#0#8'TListBox'#9'I' + +'temsList'#4'Left'#3#200#0#3'Top'#3#128#0#5'Width'#3#137#0#6'Height'#2'y'#10 + +'ItemHeight'#2#13#8'TabOrder'#2#8#0#0#5'TEdit'#10'RefGrpEdit'#4'Left'#3'8'#1 + +#3'Top'#3'@'#1#5'Width'#2#25#6'Height'#2#21#8'TabOrder'#2#9#4'Text'#6#10'Ref' + +'GrpEdit'#0#0#5'TEdit'#11'TrgtGrpEdit'#4'Left'#3'8'#1#3'Top'#3'X'#1#5'Width' + +#2#25#6'Height'#2#21#8'TabOrder'#2#10#4'Text'#6#11'TrgtGrpEdit'#0#0#7'TButto' + +'n'#8'ResetBtn'#4'Left'#2#8#3'Top'#3#152#1#5'Width'#2'A'#6'Height'#2#25#7'Ca' + +'ption'#6#5'Reset'#8'TabOrder'#2#11#7'OnClick'#7#13'ResetBtnClick'#0#0#7'TBu' + +'tton'#10'ComputeBtn'#4'Left'#3#208#0#3'Top'#3#152#1#5'Width'#2'A'#6'Height' + +#2#25#7'Caption'#6#7'Compute'#8'TabOrder'#2#12#7'OnClick'#7#15'ComputeBtnCli' + +'ck'#0#0#7'TButton'#9'ReturnBtn'#4'Left'#3#144#1#3'Top'#3#152#1#5'Width'#2'A' + +#6'Height'#2#25#7'Caption'#6#6'Return'#11'ModalResult'#2#1#8'TabOrder'#2#13#7 + +'OnClick'#7#14'ReturnBtnClick'#0#0#9'TGroupBox'#9'GroupBox1'#4'Left'#3'`'#1#3 + +'Top'#2'p'#5'Width'#2'q'#6'Height'#3#169#0#7'Caption'#6#7'Options'#8'TabOrde' + +'r'#2#14#0#9'TCheckBox'#12'ItemStatsChk'#4'Left'#2#8#3'Top'#2#16#5'Width'#2 + +'Y'#6'Height'#2#17#7'Caption'#6#15'Item Statistics'#7'Checked'#9#5'State'#7#9 + +'cbChecked'#8'TabOrder'#2#0#0#0#9'TCheckBox'#12'TestStatsChk'#4'Left'#2#8#3 + +'Top'#2' '#5'Width'#2'Y'#6'Height'#2#17#7'Caption'#6#15'Test Statistics'#8'T' + +'abOrder'#2#1#0#0#9'TCheckBox'#12'ItemCorrsChk'#4'Left'#2#8#3'Top'#2'0'#5'Wi' + +'dth'#2'a'#6'Height'#2#17#7'Caption'#6#16'Item Intercorr.s'#8'TabOrder'#2#2#0 + +#0#9'TCheckBox'#11'ItemTestChk'#4'Left'#2#8#3'Top'#2'@'#5'Width'#2'Y'#6'Heig' + +'ht'#2#17#7'Caption'#6#15'Item-Test cor.s'#8'TabOrder'#2#3#0#0#9'TCheckBox'#8 + +'AlphaChk'#4'Left'#2#8#3'Top'#2'P'#5'Width'#2'a'#6'Height'#2#17#7'Caption'#6 + +#17'Alpha Reliability'#8'TabOrder'#2#4#0#0#9'TCheckBox'#11'LogisticChk'#4'Le' + +'ft'#2#8#3'Top'#2'p'#5'Width'#2'a'#6'Height'#2#17#7'Caption'#6#16'Logistic R' + +'egres.'#7'Enabled'#8#8'TabOrder'#2#5#0#0#9'TCheckBox'#5'MHChk'#4'Left'#2#8#3 + +'Top'#2'`'#5'Width'#2'a'#6'Height'#2#17#7'Caption'#6#15'Mantel-Haenszel'#7'C' + +'hecked'#9#5'State'#7#9'cbChecked'#8'TabOrder'#2#6#0#0#9'TCheckBox'#9'Curves' + +'Chk'#4'Left'#2#8#3'Top'#3#128#0#5'Width'#2'a'#6'Height'#2#17#7'Caption'#6#16 + +'Item Char. Crvs.'#8'TabOrder'#2#7#0#0#9'TCheckBox'#9'CountsChk'#4'Left'#2#8 + +#3'Top'#3#144#0#5'Width'#2'a'#6'Height'#2#17#7'Caption'#6#12'Level Counts'#8 + +'TabOrder'#2#8#0#0#0#5'TEdit'#10'LevelsEdit'#4'Left'#3'8'#1#3'Top'#3'p'#1#5 + +'Width'#2#25#6'Height'#2#21#8'TabOrder'#2#15#6'OnExit'#7#14'LevelsEditExit'#0 + +#0#5'TEdit'#11'LevelNoEdit'#4'Left'#3#184#1#3'Top'#3'@'#1#5'Width'#2#25#6'He' + +'ight'#2#21#8'TabOrder'#2#16#4'Text'#6#1'1'#0#0#5'TEdit'#12'LowBoundEdit'#4 + +'Left'#3#184#1#3'Top'#3'X'#1#5'Width'#2#25#6'Height'#2#21#8'TabOrder'#2#17#6 + +'OnExit'#7#16'LowBoundEditExit'#0#0#5'TEdit'#11'UpBoundEdit'#4'Left'#3#184#1 + +#3'Top'#3'p'#1#5'Width'#2#25#6'Height'#2#21#8'TabOrder'#2#18#6'OnExit'#7#15 + +'UpBoundEditExit'#0#0#10'TScrollBar'#11'LevelScroll'#4'Left'#3'`'#1#3'Top'#3 + +'@'#1#5'Width'#2'Q'#6'Height'#2#19#3'Min'#2#1#8'PageSize'#2#0#8'Position'#2#1 + +#8'TabOrder'#2#19#8'OnScroll'#7#17'LevelScrollScroll'#0#0#0 +]); diff --git a/applications/lazstats/source/not used by LazStats/dif.pas b/applications/lazstats/source/not used by LazStats/dif.pas new file mode 100644 index 000000000..8d7001632 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/dif.pas @@ -0,0 +1,1008 @@ +unit DIF; + +{$MODE Delphi} + +interface + +uses + LCLIntf, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Buttons, OS3MainUnit, GLOBALS, Math, OUTPUTUNIT, MATRIXLIB, + DATAPROCS, FUNCTIONSLIB, GRAPHLib, LResources; + +type DynamicCharArray = array of char; + +type + TDIFfrm = class(TForm) + Memo1: TMemo; + Label1: TLabel; + VarList: TListBox; + ItemInBtn: TBitBtn; + ItemOutBtn: TBitBtn; + AllBtn: TBitBtn; + GrpInBtn: TBitBtn; + GrpOutBtn: TBitBtn; + Label2: TLabel; + Label3: TLabel; + GroupVarEdit: TEdit; + ItemsList: TListBox; + Label4: TLabel; + Label5: TLabel; + RefGrpEdit: TEdit; + TrgtGrpEdit: TEdit; + ResetBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + GroupBox1: TGroupBox; + ItemStatsChk: TCheckBox; + TestStatsChk: TCheckBox; + ItemCorrsChk: TCheckBox; + ItemTestChk: TCheckBox; + AlphaChk: TCheckBox; + LogisticChk: TCheckBox; + MHChk: TCheckBox; + Label6: TLabel; + LevelsEdit: TEdit; + Label7: TLabel; + LevelNoEdit: TEdit; + Label8: TLabel; + Label9: TLabel; + LowBoundEdit: TEdit; + UpBoundEdit: TEdit; + LevelScroll: TScrollBar; + Label10: TLabel; + Label11: TLabel; + Label12: TLabel; + CurvesChk: TCheckBox; + CountsChk: TCheckBox; + procedure ResetBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ReturnBtnClick(Sender: TObject); + procedure ComputeBtnClick(Sender: TObject); + procedure ItemInBtnClick(Sender: TObject); + procedure ItemOutBtnClick(Sender: TObject); + procedure AllBtnClick(Sender: TObject); + procedure GrpInBtnClick(Sender: TObject); + procedure LowBoundEditExit(Sender: TObject); + procedure UpBoundEditExit(Sender: TObject); + procedure LevelsEditExit(Sender: TObject); + procedure LevelScrollScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); + private + { Private declarations } + NoItems : integer; + nolevels : integer; + tmean, tvar, tsd : double; + ColNoSelected : IntDyneVec; + ColLabels, RowLabels : StrDyneVec; + Means, Variances, StdDevs : DblDyneVec; + CorMat : DblDyneMat; // correlations among items and total score + Data : IntDyneMat; //store item scores and total score + Ubounds : IntDyneVec; // upper and lower bounds of score groups + Lbounds : IntdyneVec; + Code : DynamicCharArray; // blank, A, B or C ETS codes + Level10OK : IntdyneMat; // check that each item category >= 10 + RMHRight : IntDyneMat; // no. right for items by score group in reference group + RMHWrong : IntDyneMat; // no. wrong for items by score group in reference group + FMHRight : IntDyneMat; // no. right for items by score group in focus group + FMHWrong : IntDyneMat; // no. wrong for items by score group in focus group + RScrGrpCnt : IntDyneMat; // total responses for score groups in reference group + FScrGrpCnt : IntDyneMat; // total responses for score groups in focus group + NT : IntDyneMat; // total right and wrong in each category of each item + Alpha : DblDyneVec; + AlphaNum : DblDyneVec; + AlphaDen : DblDyneVec; + MHDiff : DblDyneVec; + ExpA : DblDyneMat; + VarA : DblDyneMat; + SumA : DblDyneVec; + SumExpA : DblDyneVec; + SumVarA : DblDyneVec; + ChiSqr : DblDyneVec; + Prob : DblDyneVec; + SEMHDDif : DblDyneVec; + Aster : StrDyneVec; + C : DblDyneVec; + CodeRF : DynamicCharArray; + Tot : IntDyneVec; + procedure AlphaRel(Sender: TObject); + procedure ItemCorrs(Sender: TObject); + procedure ItemTestCorrs(Sender: TObject); + procedure ItemCurves(Sender: TObject); + +public + { Public declarations } + end; + +var + DIFfrm: TDIFfrm; + +implementation + + +procedure TDIFfrm.ResetBtnClick(Sender: TObject); +var i : integer; +begin + VarList.Clear; + ItemsList.Clear; + GroupVarEdit.Text := ''; + ItemInBtn.Visible := true; + ItemOutBtn.Visible := false; + AllBtn.Visible := true; + GrpInBtn.Visible := true; + GrpOutBtn.Visible := false; + ItemStatsChk.Checked := true; + TestStatsChk.Checked := false; + ItemCorrsChk.Checked := false; + ItemTestChk.Checked := false; + MHChk.Checked := true; + LogisticChk.Checked := false; + RefGrpEdit.Text := ''; + TrgtGrpEdit.Text := ''; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + if NoVariables > 0 then LevelScroll.Max := NoVariables; + LevelNoEdit.Text := '1'; + LowBoundEdit.Text := '0'; + UpBoundEdit.Text := '2'; + //allocate space on heap + SetLength(ColLabels,NoVariables+1); + SetLength(RowLabels,NoVariables+1); + SetLength(Means,NoVariables); + SetLength(Variances,NoVariables); + SetLength(StdDevs,NoVariables); + SetLength(CorMat,NoVariables,NoVariables); + SetLength(Data,NoCases,NoVariables+3); //group, items, total, flag + SetLength(Lbounds,NoVariables); + SetLength(Ubounds,NoVariables); + SetLength(Tot,NoCases); + SetLength(ColNoSelected,NoVariables); +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.ReturnBtnClick(Sender: TObject); +begin + ColNoSelected := nil; + C := nil; + SEMHDDif := nil; + Aster := nil; + Prob := nil; + ChiSqr := nil; + SumVarA := nil; + SumExpA := nil; + SumA := nil; + VarA := nil; + ExpA := nil; + CodeRF := nil; + MHDiff := nil; + AlphaDen := nil; + AlphaNum := nil; + Alpha := nil; + NT := nil; + Level10OK := nil; + Code := nil; + FScrGrpCnt := nil; + RScrGrpCnt := nil; + FMHWrong := nil; + FMHRight := nil; + RMHWrong := nil; + RMHRight := nil; + Tot := nil; + Ubounds := nil; + Lbounds := nil; + Data := nil; + CorMat := nil; + StdDevs := nil; + Variances := nil; + Means := nil; + RowLabels := nil; + ColLabels := nil; + DIFfrm.Hide; +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.ComputeBtnClick(Sender: TObject); +Label LoopStart; +var + i, j, k : integer; + itm : integer; + grpvar : integer; + subjgrp : integer; + value : integer; + subjscore : integer; + scrgrpsize : integer; + lower, upper : integer; + sum : integer; + cellstring : string; + title : string; + nsize : array [1..2] of integer; + Rtm, Wtm : double; + TotPurge : integer; + LoopIt : integer; + RItem, FItem : integer; +begin + LoopIt := 0; + OutPutFrm.RichEdit.Clear; + OutPutFrm.RichEdit.Lines.Add('Mantel-Haenszel DIF Analysis adapted by Bill Miller from'); + OutPutFrm.RichEdit.Lines.Add('EZDIF written by Niels G. Waller'); + OutPutFrm.RichEdit.Lines.Add(''); + + NoItems := ItemsList.Items.Count; + for k := 1 to 2 do nsize[k] := 0; + + // get items to analyze and their labels + for i := 1 to NoItems do // items to analyze + begin + for j := 1 to NoVariables do // variables in grid + begin + cellstring := OS3MainFrm.DataGrid.Cells[j,0]; + if cellstring = ItemsList.Items.Strings[i-1] then + begin // matched - save info + ColNoSelected[i-1] := j; + ColLabels[i-1] := cellstring; + RowLabels[i-1] := cellstring; + end; // end match + end; // next j + end; // next i + ColLabels[NoItems] := 'TOTAL'; + RowLabels[NoItems] := 'TOTAL'; + + // get the variable number of the grouping code + grpvar := 0; + for i := 1 to NoVariables do + begin + cellstring := OS3MainFrm.DataGrid.Cells[i,0]; + if cellstring = GroupVarEdit.Text then grpvar := i; + end; + if grpvar = 0 then + begin + ShowMessage('Error - No group variable found.'); + exit; + end; + + // get number of test score levels + nolevels := StrToInt(LevelsEdit.Text); + + // read data (score group and items) + for i := 1 to NoCases do + begin + subjscore := 0; + value := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[grpvar,i]))); + subjgrp := 0; + if value = StrToInt(RefGrpEdit.Text) then subjgrp := 1; // reference grp + if value = StrToInt(TrgtGrpEdit.Text) then subjgrp := 2; // target group + if subjgrp = 0 then + begin + ShowMessage('Error - Bad group code for a subject.'); + exit; + end; + Data[i-1,0] := subjgrp; + nsize[subjgrp] := nsize[subjgrp] + 1; + for j := 1 to NoItems do + begin + itm := ColNoSelected[j-1]; + value := Round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[itm,i]))); + if value = 1 then subjscore := subjscore + 1; + Data[i-1,j] := value; + end; + Tot[i-1] := subjscore; + end; + + // obtain item means, variances, standard deviations for total subjects + for i := 0 to NoItems-1 do + begin + Means[i] := 0.0; + Variances[i] := 0.0; + StdDevs[i] := 0.0; + for j := 0 to NoCases - 1 do + begin + Means[i] := Means[i] + Data[j,i+1]; + Variances[i] := Variances[i] + (Data[j,i+1] * Data[j,i+1]); + end; + Variances[i] := (Variances[i] - (Means[i] * Means[i] / NoCases)) / (NoCases - 1); + if Variances[i] <= 0 then + begin + cellstring := format('Item %d has zero variance. Unselect the item.', + [i+1]); + ShowMessage(cellstring); + ResetBtnClick(Self); + exit; + end; + StdDevs[i] := sqrt(Variances[i]); + Means[i] := Means[i] / NoCases; + end; + + // obtain total score mean, variance and stddev + tmean := 0.0; + tvar := 0.0; + tsd := 0.0; + for i := 0 to NoCases - 1 do + begin + tmean := tmean + Tot[i]; + tvar := tvar + (Tot[i] * Tot[i]); + end; + tvar := (tvar - (tmean * tmean / NoCases)) / (NoCases - 1); + tsd := sqrt(tvar); + tmean := tmean / NoCases; + + // print descriptives if checked + if ItemStatsChk.Checked then + begin + title := 'Total Means'; + DynVectorPrint(Means,NoItems,title,ColLabels,NoCases); + title := 'Total Variances'; + DynVectorPrint(Variances,NoItems,title,ColLabels,NoCases); + title := 'Total Standard Deviations'; + DynVectorPrint(StdDevs,NoItems,title,ColLabels,NoCases); + end; + + // Show total test score statistics if checked + if TestStatsChk.Checked then + begin + cellstring := format('Total Score: Mean = %10.3f, Variance = %10.3f, Std.Dev. = %10.3f', + [tmean, tvar, tsd]); + OutPutFrm.RichEdit.Lines.Add(cellstring); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + end; + cellstring := format('Reference group size = %d, Focus group size = %d', + [nsize[1],nsize[2]]); + OutPutFrm.RichEdit.Lines.Add(cellstring); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + + // get Cronbach alpha for total group if checked + if AlphaChk.Checked then AlphaRel(Self); + + // Get item intercorrelations for total group if checked + if ItemCorrsChk.Checked then + begin + ItemCorrs(Self); + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + end; + + // Get item-total score correlations for total group if checked + if ItemTestChk.Checked then + begin + ItemTestCorrs(Self); + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + end; + + // Show upper and lower bounds for score group bins + OutPutFrm.RichEdit.Lines.Add('Conditioning Levels'); + OutPutFrm.RichEdit.Lines.Add('Lower Upper'); + for i := 0 to nolevels-1 do + begin + cellstring := format('%5d %5d',[Lbounds[i],Ubounds[i]]); + OutPutFrm.RichEdit.Lines.Add(cellstring); + end; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.ShowModal; + + // check for zero variance in each group + for k := 1 to 2 do // group + begin + for i := 0 to NoItems-1 do // item + begin + sum := 0; + for j := 0 to NoCases-1 do // subject + begin + if Data[j,0] = k then // group match ? + begin + sum := sum + Data[j,i+1]; + end; + end; + end; + if ((sum = 0) or (sum = NoVariables)) then + begin + cellstring := format('Item %d in group %d has zero variance.', + [i+1,k]); + ShowMessage(cellstring); + exit; + end; + end; + + // Get count of no. right and wrong for each item in each group + SetLength(RMHRight,nolevels,NoItems); + SetLength(RMHWrong,nolevels,NoItems); + SetLength(FMHRight,nolevels,NoItems); + SetLength(FMHWrong,nolevels,NoItems); + SetLength(RScrGrpCnt,nolevels,NoItems); + SetLength(FScrGrpCnt,nolevels,NoItems); + SetLength(Code,NoItems); + SetLength(Level10OK,nolevels,NoItems); + SetLength(NT,nolevels,NoItems); + SetLength(Alpha,NoItems); + SetLength(AlphaNum,NoItems); + SetLength(AlphaDen,NoItems); + SetLength(MHDiff,NoItems); + SetLength(CodeRF,NoItems); + SetLength(ExpA,nolevels,NoItems); + SetLength(VarA,nolevels,NoItems); + SetLength(SumA,NoItems); + SetLength(SumExpA,NoItems); + SetLength(SumVarA,NoItems); + SetLength(ChiSqr,NoItems); + SetLength(Prob,NoItems); + SetLength(Aster,NoItems); + SetLength(SEMHDDif,NoItems); + SetLength(C,NoItems); + +LoopStart: + // clear arrays + for j := 0 to NoItems-1 do + begin + for k := 0 to nolevels-1 do + begin + RMHRight[k,j] := 0; + RMHWrong[k,j] := 0; + RScrGrpCnt[k,j] := 0; + FMHRight[k,j] := 0; + FMHWrong[k,j] := 0; + FScrGrpCnt[k,j] := 0; + Level10OK[k,j] := 1; + NT[k,j] := 0; + ExpA[k,j] := 0.0; + VarA[k,j] := 0.0; + end; + Alpha[j] := 0.0; + AlphaNum[j] := 0.0; + AlphaDen[j] := 0.0; + MHDiff[j] := 0.0; + CodeRF[j] := ' '; + Prob[j] := 0.0; + end; + + LoopIt := LoopIt + 1; + OutPutFrm.RichEdit.Clear; + cellstring := format('COMPUTING M-H CHI-SQUARE, PASS # %d',[LoopIt]); + OutPutFrm.RichEdit.Lines.Add(cellstring); + for k := 0 to nolevels-1 do + begin + for i := 0 to NoCases-1 do + begin + subjgrp := Data[i,0]; + for j := 0 to NoItems-1 do + begin + RItem := 0; + value := Data[i,j+1]; + if ((LoopIt = 2) and (Code[j] = 'C')) then RItem := value; + if value = 1 then + begin + if ((Tot[i]+RItem >= Lbounds[k]) and + (Tot[i]+RItem <= Ubounds[k])) then + begin + if subjgrp = 1 then + begin + RMHRight[k,j] := RMHRight[k,j] + 1; + RScrGrpCnt[k,j] := RScrGrpCnt[k,j] + 1; + end; // if reference group + if subjgrp = 2 then + begin + FMHRight[k,j] := FMHRight[k,j] + 1; + FScrGrpCnt[k,j] := FScrGrpCnt[k,j] + 1; + end; // if focus group + end; // end if () and () + end; // value = 1 + if value = 0 then + begin + if ((Tot[i]+RItem >= Lbounds[k]) and + (Tot[i]+RItem <= Ubounds[k])) then + begin + if subjgrp = 1 then + begin + RMHWrong[k,j] := RMHWrong[k,j] + 1; + RScrGrpCnt[k,j] := RScrGrpCnt[k,j] + 1; + end; + if subjgrp = 2 then + begin + FMHWrong[k,j] := FMHWrong[k,j] + 1; + FScrGrpCnt[k,j] := FScrGrpCnt[k,j] + 1; + end; + end; + end; // if value = 0 + end; // next j + end; // next i + end; // next k + for j := 0 to NoItems-1 do Code[j] := 'Z'; // clean out ETS code + + // print score group counts for Reference and focus subjects + if CountsChk.Checked then + begin + for i := 0 to nolevels-1 do + RowLabels[i] := format('%3d-%3d',[Lbounds[i],Ubounds[i]]); + DynIntMatPrint(RScrGrpCnt,nolevels,NoItems,'Score Level Counts by Item',RowLabels,ColLabels, + 'Cases in Reference Group'); + DynIntMatPrint(FScrGrpCnt,nolevels,NoItems,'Score Level Counts by Item',RowLabels,ColLabels, + 'Cases in Focus Group'); + end; + + // Plot Item curves if checked + if ((CurvesChk.Checked) and (LoopIt = 1)) then ItemCurves(Self); + + // check for minimum of 10 per category in each item + // compute NT + for j := 0 to NoItems-1 do + begin + for k := 0 to nolevels-1 do + begin + if ((RScrGrpCnt[k,j] < 10) or (FScrGrpCnt[k,j] < 10)) then + Level10OK[k,j] := 0 // insufficient n + else Level10OK[k,j] := 1; // 10 or more - OK + NT[k,j] := RScrGrpCnt[k,j] + FScrGrpCnt[k,j]; + end; + end; + + for k := 0 to nolevels-1 do + begin + if Level10OK[k,0] = 0 then + begin + cellstring := format('Insufficient data found in level: %d - %d', + [Lbounds[k],Ubounds[k]]); + OutPutFrm.RichEdit.Lines.Add(cellstring); + end; + end; + + // compute alpha + for j := 0 to NoItems - 1 do + begin + for k := 0 to nolevels-1 do + begin + if Level10OK[k,j] = 1 then + begin + AlphaNum[j] := AlphaNum[j] + (RMHRight[k,j] * FMHWrong[k,j]) / NT[k,j]; + AlphaDen[j] := AlphaDen[j] + (RMHWrong[k,j] * FMHRight[k,j]) / NT[k,j]; + end; + end; + end; + + for j := 0 to NoItems-1 do + begin + if AlphaDen[j] = 0.0 then + begin + cellstring := format('Window too small at item %d level %d', + [j+1,k+1]); + ShowMessage(cellstring); + exit; + end + else begin + Alpha[j] := AlphaNum[j] / AlphaDen[j]; + MHDiff[j] := -2.35 * ln(Alpha[j]); + end; + end; + + // compute expected values + for j := 0 to NoItems-1 do + begin + for k := 0 to nolevels-1 do + begin + if Level10OK[k,j] = 1 then + begin + ExpA[k,j] := (RScrGrpCnt[k,j] * (RMHRight[k,j] + FMHRight[k,j] )) / + NT[k,j]; + end; + end; + end; + + // compute variances + for j := 0 to NoItems-1 do + begin + for k := 0 to nolevels-1 do + begin + if Level10OK[k,j] = 1 then + begin + Rtm := RMHRight[k,j] + FMHRight[k,j]; + Wtm := RMHWrong[k,j] + FMHWrong[k,j]; + VarA[k,j] := (RScrGrpCnt[k,j] * FScrGrpCnt[k,j] * Rtm * Wtm) / + ( NT[k,j] * NT[k,j] * (NT[k,j]-1) ); + end; + end; + end; + + // compute chi-squares + for j := 0 to NoItems-1 do + begin + SumA[j] := 0.0; + SumExpA[j] := 0.0; + SumVarA[j] := 0.0; + for k := 0 to nolevels-1 do + begin + if Level10OK[k,j] = 1 then + begin + SumA[j] := SumA[j] + RMHRight[k,j]; + SumExpA[j] := SumExpA[j] + ExpA[k,j]; + SumVarA[j] := SumVarA[j] + VarA[k,j]; + end; + end; + end; + + for j := 0 to NoItems-1 do + begin + ChiSqr[j] := (sqr((Abs(SumA[j] - SumExpA[j]) - 0.5))) / SumVarA[j]; + Prob[j] := 1.0 - chisquaredprob(ChiSqr[j],1); + if Prob[j] > 0.05 then Aster[j] := ''; + if Prob[j] <= 0.05 then Aster[j] := '*'; + if Prob[j] <= 0.01 then Aster[j] := '**'; + if Prob[j] <= 0.005 then Aster[j] := '***'; + end; + + // compute std. errors + for j := 0 to NoItems-1 do + begin + C[j] := 0.0; + for k := 0 to nolevels-1 do + begin + if Level10OK[k,j] = 1 then + C[j] := C[j] + ((RMHRight[k,j] * FMHWrong[k,j]) / NT[k,j]); + end; + end; + + for j := 0 to NoItems - 1 do + begin + SEMHDDif[j] := 0.0; + for k := 0 to nolevels-1 do + begin + if Level10OK[k,j] = 1 then + begin + SEMHDDif[j] := SEMHDDif[j] + ( (RMHRight[k,j] * FMHWrong[k,j] ) + + ( Alpha[j] * RMHWrong[k,j] * FMHRight[k,j])) * + ( RMHRight[k,j] + FMHWrong[k,j] + Alpha[j] * + ( RMHWrong[k,j] + FMHRight[k,j] )) / ( 2.0 * NT[k,j] * NT[k,j]); + end; + end; + end; + + for j := 0 to NoItems-1 do + SEMHDDif[j] := (2.35 / C[j]) * sqrt(SEMHDDif[j]); + + // code results with ETS codes + for j := 0 to NoItems-1 do + begin + if ( (abs(MHDiff[j]) > 1.5) and ((abs(MHDiff[j]) - (1.96 * SEMHDDif[j]) + > 1.0))) then Code[j] := 'C'; + if ((abs(MHDiff[j]) - (1.96 * SEMHDDif[j]) <= 0.0) or + (abs(MHDiff[j]) <= 1.0)) then code[j] := 'A'; + if ((code[j] <> 'A') and (code[j] <> 'C')) then code[j] := 'B'; + end; + + // purge + TotPurge := 0; + for j := 0 to NoItems-1 do + begin + if (code[j] = 'C') then + begin + TotPurge := TotPurge + 1; + for i := 0 to NoCases - 1 do Tot[i] := Tot[i] - Data[i,j+1]; + if Alpha[j] > 1.0 then CodeRF[j] := 'R'; + if Alpha[j] < 1.0 then CodeRF[j] := 'F'; + end; + end; + + // show results +// OutPutFrm.RichEdit.Clear; + OutPutFrm.RichEdit.Lines.Add( + 'CODES ITEM SIG. ALPHA CHI2 P-VALUE MH D-DIF S.E. MH D-DIF'); + for j := 0 to noitems-1 do + begin + cellstring := format('%1s %1s %4d %3s %6.3f %7.3f %6.3f %6.3f %6.3f', + [code[j],CodeRF[j], j+1, Aster[j],Alpha[j],ChiSqr[j],Prob[j],MHDiff[j], + SEMHDDif[j]]); + OutPutFrm.RichEdit.Lines.Add(cellstring); + end; + OutPutFrm.RichEdit.Lines.Add(''); + if LoopIt = 1 then + begin + cellstring := format('No. of items purged in pass 1 = %d',[TotPurge]); + OutPutFrm.RichEdit.Lines.Add(cellstring); + OutPutFrm.RichEdit.Lines.Add('Item Numbers:'); + for j := 0 to NoItems-1 do + begin + if Code[j] = 'C' then + begin + cellstring := format('%d',[j+1]); + OutPutFrm.RichEdit.Lines.Add(cellstring); + end; + end; + end; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.ShowModal; + if LoopIt < 2 then goto LoopStart; +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.ItemInBtnClick(Sender: TObject); +var + index, i : integer; + +begin + if VarList.ItemIndex < 0 then + begin + ItemInBtn.Visible := false; + exit; + end; + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + ItemsList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + ItemOutBtn.Visible := true; +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.ItemOutBtnClick(Sender: TObject); +var + index: integer; + +begin + index := ItemsList.ItemIndex; + if index < 0 then + begin + ItemOutBtn.Visible := false; + exit; + end; + VarList.Items.Add(ItemsList.Items.Strings[index]); + ItemsList.Items.Delete(index); + ItemInBtn.Visible := true; +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.AllBtnClick(Sender: TObject); +var + i : integer; +begin + if VarList.Items.Count < 1 then exit; + for i := 0 to VarList.Items.Count - 1 do + ItemsList.Items.Add(VarList.Items.Strings[i]); + VarList.Clear; + ItemInBtn.Visible := false; + ItemOutBtn.Visible := true; +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.GrpInBtnClick(Sender: TObject); +var index : integer; +begin + if VarList.ItemIndex < 0 then + begin + GrpInBtn.Visible := false; + exit; + end; + index := VarList.ItemIndex; + GroupVarEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + GrpInBtn.Visible := false; + GrpOutBtn.Visible := true; +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.LowBoundEditExit(Sender: TObject); +var i : integer; +begin + i := StrToInt(LevelNoEdit.Text); + Lbounds[i-1] := StrToInt(LowBoundEdit.Text); + UpBoundEdit.SetFocus; +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.UpBoundEditExit(Sender: TObject); +var i : integer; +begin + i := StrToInt(LevelNoEdit.Text); + Ubounds[i-1] := StrToInt(UpBoundEdit.Text); + if i = StrToInt(LevelsEdit.Text) then + begin + ComputeBtn.SetFocus; + exit; + end; + LowBoundEdit.Text := IntToStr(Ubounds[i-1] + 1); + LowBoundEdit.SetFocus; +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.LevelsEditExit(Sender: TObject); +begin + LevelScroll.Max := StrToInt(LevelsEdit.Text); + LowBoundEdit.SetFocus; +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.LevelScrollScroll(Sender: TObject; + ScrollCode: TScrollCode; var ScrollPos: Integer); +var + scrlpos : integer; + level : integer; +begin + level := StrToInt(LevelNoEdit.Text); + scrlpos := LevelScroll.Position; + if ((scrlpos > level) and (level <= StrToInt(LevelsEdit.Text))) then + begin + LevelNoEdit.Text := IntToStr(scrlpos); + LowBoundEdit.SetFocus; + exit; + end; + if scrlpos < level then + begin + level := scrlpos; + if level > 0 then + begin + LevelNoEdit.Text := IntToStr(level); + LowBoundEdit.Text := IntToStr(Lbounds[level-1]); + UpBoundEdit.Text := IntToStr(Ubounds[level-1]); + end; + LowBoundEdit.SetFocus; + end; +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.AlphaRel(Sender: TObject); +var + i : integer; + AlphaRel, SEMeas : double; + outline : string; + +begin + OutPutFrm.RichEdit.Clear; + OutPutFrm.RichEdit.Lines.Add(''); + AlphaRel := 0.0; + + for i := 0 to NoItems-1 do + AlphaRel := AlphaRel + variances[i]; // sum of item variances + AlphaRel := AlphaRel / tvar; + AlphaRel := 1.0 - AlphaRel; + AlphaRel := (NoItems / (NoItems - 1.0)) * AlphaRel; + SEMeas := tsd * sqrt(1.0 - AlphaRel); + outline := format('Alpha Reliability Estimate for Test = %6.4f S.E. of Measurement = %8.3f', + [AlphaRel,SEMeas]); + OutPutFrm.RichEdit.Lines.Add(outline); +// OutPutFrm.ShowModal; +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.ItemCorrs(Sender: TObject); +var + i, j, k : integer; + title : string; +begin + // cross-products + for i := 0 to NoItems-1 do + for j := 0 to NoItems-1 do + for k := 0 to NoCases-1 do + CorMat[i,j] := CorMat[i,j] + (Data[k,i+1] * Data[k,j+1]); + // covariances + for i := 0 to NoItems-1 do + for j := 0 to NoItems-1 do + CorMat[i,j] := (CorMat[i,j] - (NoCases * Means[i] * Means[j])) / + (NoCases-1); + + // correlations + for i := 0 to NoItems-1 do + for j := 0 to NoItems-1 do + CorMat[i,j] := CorMat[i,j] / (StdDevs[i] * StdDevs[j]); + + // show results + OutPutFrm.RichEdit.Clear; + title := 'Correlations Among Items'; + MAT_PRINT(CorMat,NoItems,NoItems,title,RowLabels,ColLabels,NoCases); +end; +//------------------------------------------------------------------- + +procedure TDIFfrm.ItemTestCorrs(Sender: TObject); +var + i, j : integer; + Cors : DblDyneVec; + title : string; +begin + SetLength(Cors,NoItems); + // cross-products + for i := 0 to NoItems-1 do + for j := 0 to NoCases-1 do + Cors[i] := Cors[i] + (Data[j,i+1] * Tot[j]); + // covariances + for i := 0 to NoItems-1 do + Cors[i] := (Cors[i] - (NoCases * Means[i] * tmean)) / (NoCases-1); + // correlations + for i := 0 to NoItems-1 do + Cors[i] := Cors[i] / (StdDevs[i] * tsd); + // show results +// OutPutFrm.RichEdit.Clear; + title := 'Item-Total Correlations'; + DynVectorPrint(Cors,NoItems,title,ColLabels,NoCases); + // release memory + Cors := nil; +end; +//------------------------------------------------------------------- +procedure TDIFfrm.ItemCurves(Sender: TObject); +var + i, ii, j : integer; + XPlotPts : DblDyneMat; + YPlotPts : DblDyneMat; + LabelStr, outline, xTitle, yTitle : string; + max : integer; + +begin + SetLength(YPlotPts,2,nolevels); + SetLength(XPlotPts,1,nolevels); + + // get maximum no. of scores in either groups bins + for i := 0 to NoItems-1 do + begin + max := 0; + for j := 0 to nolevels-1 do + begin + if RMHRight[j,i] > max then max := RMHRight[j,i]; + if FMHRight[j,i] > max then max := FMHRight[j,i]; + end; + + // Plot reference group in blue, focus group in red + for ii := 1 to 2 do // possible group curves + begin + for j := 0 to nolevels-1 do //get points to plot + begin + XPlotPts[0,j] := Lbounds[j]; + if ii = 1 then YPlotPts[ii-1,j] := RMHRight[j,i]; + if ii = 2 then YPlotPts[ii-1,j] := FMHRight[j,i]; + end; + end; // next group + + // Plot the points + GraphFrm.BackColor := clWhite; + GraphFrm.ShowLeftWall := true; + GraphFrm.ShowRightWall := true; + GraphFrm.ShowBottomWall := true; + GraphFrm.ShowBackWall := true; + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlue; + GraphFrm.FloorColor := clBlue; + outline := format('Blue = Reference, Red = Focus for item %d',[i+1]); + GraphFrm.Heading := outline; + xTitle := 'Lower bounds of levels'; + GraphFrm.XTitle := xTitle; + yTitle := 'Frequencies'; + GraphFrm.YTitle := yTitle; + GraphFrm.nosets := 2; + GraphFrm.nbars := nolevels; + GraphFrm.barwideprop := 0.5; + GraphFrm.miny := 0.0; + GraphFrm.maxy := max; + GraphFrm.AutoScale := false; + GraphFrm.GraphType := 5; // 2d line charts + GraphFrm.PtLabels := false; + for ii := 1 to 2 do + begin + if ii = 1 then LabelStr := 'Reference'; + if ii = 2 then LabelStr := 'Focus'; + GraphFrm.SetLabels[ii] := LabelStr; + end; + GraphFrm.Ypoints := YPlotPts; + GraphFrm.Xpoints := XPlotPts; + GraphFrm.ShowModal; + end; // next item + + XPlotPts := nil; + YPlotPts := nil; + +end; +//------------------------------------------------------------------- + +initialization + {$i DIF.lrs} + {$i DIF.lrs} + +end. diff --git a/applications/lazstats/source/not used by LazStats/essayunit.lfm b/applications/lazstats/source/not used by LazStats/essayunit.lfm new file mode 100644 index 000000000..a69410a55 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/essayunit.lfm @@ -0,0 +1,344 @@ +object EssayFrm: TEssayFrm + Left = 23 + Height = 479 + Top = 10 + Width = 658 + HelpContext = 1855 + BorderStyle = bsDialog + Caption = 'Essay Item Specification' + ClientHeight = 479 + ClientWidth = 658 + Color = clBtnFace + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + HelpFile = 'ITEMBANKHELP.HLP' + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Label2: TLabel + Left = 16 + Height = 13 + Top = 8 + Width = 63 + Caption = 'Item Number:' + ParentColor = False + end + object Label1: TLabel + Left = 160 + Height = 13 + Top = 8 + Width = 281 + Caption = 'Click on the Item Classification Code listed in the box below.' + ParentColor = False + end + object Label14: TLabel + Left = 16 + Height = 13 + Top = 64 + Width = 89 + Caption = 'Bit Map File Name:' + ParentColor = False + end + object Label15: TLabel + Left = 16 + Height = 13 + Top = 88 + Width = 72 + Caption = 'Image (if used):' + ParentColor = False + end + object Label16: TLabel + Left = 120 + Height = 13 + Top = 80 + Width = 97 + Caption = '(Thumb Nail Sketch)' + ParentColor = False + end + object BMPImage: TImage + Left = 112 + Height = 97 + Top = 96 + Width = 121 + Center = True + Stretch = True + end + object Label18: TLabel + Left = 248 + Height = 13 + Top = 96 + Width = 60 + Caption = 'Item Weight:' + ParentColor = False + end + object Label3: TLabel + Left = 16 + Height = 13 + Top = 208 + Width = 47 + Caption = 'Item Stem' + ParentColor = False + end + object Label4: TLabel + Left = 16 + Height = 13 + Top = 328 + Width = 92 + Caption = 'Suggested Answer:' + ParentColor = False + end + object Label5: TLabel + Left = 600 + Height = 13 + Top = 8 + Width = 39 + Caption = 'Symbols' + ParentColor = False + end + object Label6: TLabel + Left = 584 + Height = 13 + Top = 24 + Width = 68 + Caption = 'Click to Select' + ParentColor = False + end + object ItemNoEdit: TEdit + Left = 104 + Height = 21 + Top = 0 + Width = 41 + TabOrder = 0 + end + object ItemNoScroll: TScrollBar + Left = 16 + Height = 16 + Top = 28 + Width = 129 + Max = 1000 + PageSize = 0 + TabOrder = 1 + OnScroll = ItemNoScrollScroll + end + object CodeCombo: TComboBox + Left = 160 + Height = 21 + Top = 24 + Width = 417 + ItemHeight = 13 + TabOrder = 2 + Text = 'Classification Code' + end + object BMPFileEdit: TEdit + Left = 112 + Height = 21 + Top = 56 + Width = 465 + TabOrder = 3 + Text = 'BMPFileEdit' + end + object BrowseBtn: TButton + Left = 24 + Height = 25 + Top = 112 + Width = 57 + Caption = 'Browse' + OnClick = BrowseBtnClick + TabOrder = 4 + end + object ClearBtn: TButton + Left = 24 + Height = 25 + Top = 144 + Width = 57 + Caption = 'Clear' + OnClick = ClearBtnClick + TabOrder = 5 + end + object ItemWeightEdit: TEdit + Left = 312 + Height = 21 + Top = 96 + Width = 33 + TabOrder = 6 + Text = 'ItemWeightEdit' + end + object Panel1: TPanel + Left = 408 + Height = 137 + Top = 80 + Width = 169 + ClientHeight = 137 + ClientWidth = 169 + TabOrder = 7 + object Label9: TLabel + Left = 6 + Height = 13 + Top = 14 + Width = 78 + Caption = 'Percent Passed:' + ParentColor = False + end + object Label10: TLabel + Left = 6 + Height = 13 + Top = 38 + Width = 97 + Caption = 'Log Difficulty (IRT1):' + ParentColor = False + end + object Label11: TLabel + Left = 6 + Height = 13 + Top = 62 + Width = 86 + Caption = 'Item Slope (IRT2):' + ParentColor = False + end + object Label12: TLabel + Left = 6 + Height = 13 + Top = 86 + Width = 96 + Caption = 'Item Chance (IRT3):' + ParentColor = False + end + object Label13: TLabel + Left = 6 + Height = 13 + Top = 110 + Width = 76 + Caption = 'Times Selected:' + ParentColor = False + end + object PcntEdit: TEdit + Left = 110 + Height = 21 + Top = 6 + Width = 41 + TabOrder = 0 + end + object IRT1Edit: TEdit + Left = 110 + Height = 21 + Top = 30 + Width = 41 + TabOrder = 1 + end + object IRT2Edit: TEdit + Left = 110 + Height = 21 + Top = 54 + Width = 41 + TabOrder = 2 + end + object IRT3Edit: TEdit + Left = 110 + Height = 21 + Top = 78 + Width = 41 + TabOrder = 3 + end + object NoSelEdit: TEdit + Left = 110 + Height = 21 + Top = 102 + Width = 41 + TabOrder = 4 + end + end + object StemMemo: TMemo + Left = 16 + Height = 97 + Top = 224 + Width = 561 + Font.CharSet = GREEK_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Times New Roman' + MaxLength = 1000 + OnEnter = StemMemoEnter + ParentFont = False + ScrollBars = ssVertical + TabOrder = 8 + WantTabs = True + WordWrap = False + end + object NewBtn: TButton + Left = 16 + Height = 25 + Top = 443 + Width = 73 + Caption = 'New Item' + OnClick = NewBtnClick + TabOrder = 9 + end + object SaveBtn: TButton + Left = 104 + Height = 25 + Top = 443 + Width = 73 + Caption = 'Save Item' + OnClick = SaveBtnClick + TabOrder = 10 + end + object DeleteBtn: TButton + Left = 192 + Height = 25 + Top = 443 + Width = 73 + Caption = 'Delete' + OnClick = DeleteBtnClick + TabOrder = 11 + end + object ReturnBtn: TButton + Left = 496 + Height = 25 + Top = 443 + Width = 73 + Caption = 'Return' + ModalResult = 1 + OnClick = ReturnBtnClick + TabOrder = 12 + end + object AnswerMemo: TMemo + Left = 16 + Height = 89 + Top = 344 + Width = 553 + Font.CharSet = GREEK_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Times New Roman' + Lines.Strings = ( + '' + ) + MaxLength = 1000 + OnEnter = AnswerMemoEnter + ParentFont = False + TabOrder = 13 + WantTabs = True + end + object SymbolBox: TListBox + Left = 592 + Height = 425 + Top = 40 + Width = 49 + Font.CharSet = GREEK_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Times New Roman' + ItemHeight = 0 + OnClick = SymbolBoxClick + ParentFont = False + TabOrder = 14 + end + object OpenPictureDialog1: TOpenPictureDialog + left = 304 + top = 440 + end + object OpenDialog1: TOpenDialog + left = 344 + top = 440 + end +end diff --git a/applications/lazstats/source/not used by LazStats/essayunit.pas b/applications/lazstats/source/not used by LazStats/essayunit.pas new file mode 100644 index 000000000..a495be87c --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/essayunit.pas @@ -0,0 +1,421 @@ +unit EssayUnit; + +{$MODE Delphi} + +interface + +uses + //Windows, Messages, + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, ItemBankGlobals, ExtDlgs, FunctionsUnit; + +type + TEssayFrm = class(TForm) + Label2: TLabel; + ItemNoEdit: TEdit; + ItemNoScroll: TScrollBar; + Label1: TLabel; + CodeCombo: TComboBox; + Label14: TLabel; + BMPFileEdit: TEdit; + Label15: TLabel; + BrowseBtn: TButton; + ClearBtn: TButton; + Label16: TLabel; + BMPImage: TImage; + Label18: TLabel; + ItemWeightEdit: TEdit; + Panel1: TPanel; + Label9: TLabel; + Label10: TLabel; + Label11: TLabel; + Label12: TLabel; + Label13: TLabel; + PcntEdit: TEdit; + IRT1Edit: TEdit; + IRT2Edit: TEdit; + IRT3Edit: TEdit; + NoSelEdit: TEdit; + Label3: TLabel; + StemMemo: TMemo; + NewBtn: TButton; + SaveBtn: TButton; + DeleteBtn: TButton; + ReturnBtn: TButton; + AnswerMemo: TMemo; + Label4: TLabel; + OpenPictureDialog1: TOpenPictureDialog; + Label5: TLabel; + SymbolBox: TListBox; + Label6: TLabel; + OpenDialog1: TOpenDialog; + procedure FormShow(Sender: TObject); + procedure ShowEssayItem(Sender: TObject; itemno : integer); + procedure ReturnBtnClick(Sender: TObject); + procedure NewBtnClick(Sender: TObject); + procedure SaveBtnClick(Sender: TObject); + procedure LoadRecord(VAR NewRcd : EssayItemRcd; Sender : TObject); + procedure DeleteBtnClick(Sender: TObject); + procedure BrowseBtnClick(Sender: TObject); + procedure ItemNoScrollScroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); + procedure ClearBtnClick(Sender: TObject); + procedure SymbolBoxClick(Sender: TObject); + procedure StemMemoEnter(Sender: TObject); + procedure AnswerMemoEnter(Sender: TObject); + private + { Private declarations } + maxitems : integer; + ARcd : EssayItemRcd; + symbol : char; + EditBox : integer; + public + { Public declarations } + end; + +var + EssayFrm: TEssayFrm; + +implementation + +{$R *.lfm} + +procedure TEssayFrm.FormShow(Sender: TObject); +var + F : TextFile; + S : string; + TF : File of EssayItemRcd; + i : integer; +begin + StemMemo.Clear; + AnswerMemo.Clear; + ItemNoScroll.Min := 1; + ItemNoScroll.Max := 1; + ItemNoEdit.Text := '1'; + ItemNoScroll.Position := 1; + CodeCombo.Text := ''; + BMPFileEdit.Text := ''; + PcntEdit.Text := '0'; + IRT1Edit.Text := '0'; + IRT2Edit.Text := '0'; + IRT3Edit.Text := '0'; + NoSelEdit.Text := '0'; + ItemWeightEdit.Text := '0'; + maxitems := 0; + OpenDialog1.DefaultExt := '.COD'; + OpenDialog1.Filter := 'Code files (*.cod)|*.COD|Text files (*.txt)|*.TXT|All files (*.*)|*.*'; + OpenDialog1.FilterIndex := 1; + OpenDialog1.FileName := BankPath + ExtractFileName(BankName) + '.COD'; + OpenDialog1.Title := 'Name of Item Code File:'; + if OpenDialog1.Execute then + begin + AssignFile(F,OpenDialog1.filename); + ReSet(F); + while not EOF(F) do + begin + readln(F,S); + CodeCombo.Items.Add(S); + end; + end + else begin + ShowMessage('You must first open a file of item codes.'); + exit; + end; + CloseFile(F); + S := BankPath + 'EssayFile' + ExtractFileName(BankName); + EssayFName := S; + if FileExists(S) { *Converted from FileExists* } then + begin + AssignFile(TF,S); + Reset(TF); + while not EOF(TF) do + begin + read(TF,EssayItem); + maxitems := maxitems + 1; + end; + CloseFile(TF); + if maxitems > ItemNoScroll.Max then + ItemNoScroll.Max := maxitems; + ItemNoScroll.Min := 1; + end + else begin // create empty file + AssignFile(TF,S); + rewrite(TF); + CloseFile(TF); + end; + for i := 1 to 20 do ARcd.BestAns[i] := ''; + if maxitems > 0 then + begin + ItemNoScroll.Position := 1; + ShowEssayItem(self,1); + end; + SymbolBox.Clear; + for i := 127 to 255 do SymbolBox.Items.Add(chr(ord(i))); +end; +//------------------------------------------------------------------- + +procedure TEssayFrm.ShowEssayItem(Sender: TObject; itemno : integer); +var + S : string; + F : File of EssayItemRcd; + where : longint; + Frecd : EssayItemRcd; + i : integer; + +begin + ItemNoEdit.Text := IntToStr(ItemNoScroll.Position); + S := BankPath + 'EssayFile' + ExtractFileName(BankName); + AssignFile(F,S); + Reset(F); + where := itemno-1; + Seek(F,where); + read(F,FRecd); + CloseFile(F); + CodeCombo.Text := Frecd.Code; + BMPFileEdit.Text := Frecd.Picture; + PcntEdit.Text := FloatToStr(Frecd.PcntPass); + if BMPFileEdit.Text <> '' then + begin + if FileExists(Frecd.Picture) { *Converted from FileExists* } then + begin + BMPImage.Picture.LoadFromFile(Frecd.Picture); + BMPImage.Visible := true; + end + else begin +// ShowMessage('Image ' + Frecd.Picture + ' not found.'); + BMPFileEdit.Text := ''; + Frecd.Picture := ''; + end; + end + else BMPImage.Visible := false; + ItemWeightEdit.Text := IntToStr(Frecd.ItemWeight); + IRT1Edit.Text := FloatToStr(Frecd.IRT[1]); + IRT2Edit.Text := FloatToStr(Frecd.IRT[2]); + IRT3Edit.Text := FLoatToStr(Frecd.IRT[3]); + StemMemo.Clear; + for i := 1 to 20 do + begin + S := Frecd.ItemStem[i]; + if length(S) > 0 then StemMemo.Lines.Add(S); + end; + AnswerMemo.Clear; + for i := 1 to 20 do + begin + S := Frecd.BestAns[i]; + if length(S) > 0 then AnswerMemo.Lines.Add(S); + end; +end; +//------------------------------------------------------------------- + +procedure TEssayFrm.ReturnBtnClick(Sender: TObject); +begin + EssayFrm.Hide; +end; +//------------------------------------------------------------------- + +procedure TEssayFrm.NewBtnClick(Sender: TObject); +begin + StemMemo.Clear; + AnswerMemo.Clear; + ItemNoScroll.Max := maxitems + 1; + ItemNoScroll.Position := ItemNoScroll.Max; + ItemNoEdit.Text := IntToStr(ItemNoScroll.Position); + CodeCombo.Text := ''; + BMPFileEdit.Text := ''; + BMPImage.Visible := false; + PcntEdit.Text := '0'; + IRT1Edit.Text := '0'; + IRT2Edit.Text := '0'; + IRT3Edit.Text := '0'; + NoSelEdit.Text := '0'; + ItemWeightEdit.Text := '0'; + BMPImage.Visible := false; +end; +//------------------------------------------------------------------- + +procedure TEssayFrm.SaveBtnClick(Sender: TObject); +var + NewRcd : EssayItemRcd; + itemno : integer; + +begin + itemno := ItemNoScroll.Position; + LoadRecord(NewRcd,self); + WriteESItem(itemno,NewRcd); + if itemno > maxitems then + begin + maxitems := itemno; + ItemNoScroll.Max := maxitems+1; + end; +end; +//------------------------------------------------------------------- + +procedure TEssayFrm.LoadRecord(VAR NewRcd : EssayItemRcd; Sender : TObject); +var + i : integer; + S : string; +begin + NewRcd.ItemNo := ItemNoScroll.Position; + NewRcd.Code := CodeCombo.Text; + for i := 0 to StemMemo.Lines.Count-1 do + begin + S := Trim(StemMemo.Lines[i]); + NewRcd.ItemStem[i+1] := S; + end; + if StemMemo.Lines.Count < 20 then + for i := StemMemo.Lines.Count+1 to 20 do NewRcd.ItemStem[i] := ''; + for i := 0 to AnswerMemo.Lines.Count-1 do + begin + S := Trim(AnswerMemo.Lines[i]); + NewRcd.BestAns[i+1] := S; + end; + if AnswerMemo.Lines.Count < 20 then + for i := AnswerMemo.Lines.Count+1 to 20 do NewRcd.BestAns[i] := ''; + NewRcd.ItemWeight := StrToInt(ItemWeightEdit.Text); + NewRcd.Picture := BMPFileEdit.Text; + NewRcd.PcntPass := StrToFloat(PcntEdit.Text); + NewRcd.IRT[1] := StrToFloat(IRT1Edit.Text); + NewRcd.IRT[2] := StrToFloat(IRT2Edit.Text); + NewRcd.IRT[3] := StrToFloat(IRT3Edit.Text); + NewRcd.FreqElect := StrToInt(NoSelEdit.Text); +end; +//------------------------------------------------------------------- + +procedure TEssayFrm.DeleteBtnClick(Sender: TObject); +var + FOld : File of EssayItemRcd; + FNew : File of EssayItemRcd; + itemno : integer; + i : integer; + SOld : string; + SNew : string; + +begin + itemno := ItemNoScroll.Position; + SOld := BankPath + 'EssayFile' + ExtractFileName(BankName); + AssignFile(FOld,SOld); + ReSet(FOld); + SNew := BankPath + 'TempEssayFile'; + AssignFile(FNew,SNew); + Rewrite(FNew); + // copy up to itemno from old file to new file + for i := 1 to itemno-1 do + begin + if not EOF(FOld) then + begin + read(FOld,ARcd); + write(FNew,ARcd); + end; + end; + // read past itemno to delete + if not EOF(FOld) then read(FOld,ARcd); + // write remaining records, if any, from old to new + if not EOF(FOld) then + begin + while not EOF(FOld) do + begin + read(FOld,ARcd); + write(FNew,ARcd); + end; + end; + CloseFile(FOld); + CloseFile(FNew); + // delete old file and rename temp file to old file name + DeleteFile(SOld); { *Converted from DeleteFile* } + RenameFile(SNew, Sold); { *Converted from RenameFile* } + maxitems := maxitems - 1; + if maxitems > 0 then ItemNoScroll.Max := maxitems else + ItemNoScroll.Max := 1; +end; +//------------------------------------------------------------------- + +procedure TEssayFrm.BrowseBtnClick(Sender: TObject); +begin + if OpenPictureDialog1.Execute then + begin + BMPFileEdit.Text := OpenPictureDialog1.FileName; + BMPImage.Picture.LoadFromFile(BMPFileEdit.Text); + BMPImage.Visible := true; + end; +end; +//------------------------------------------------------------------- + +procedure TEssayFrm.ItemNoScrollScroll(Sender: TObject; + ScrollCode: TScrollCode; var ScrollPos: Integer); +var + itemno : integer; +begin + itemno := ScrollPos; + if (itemno > maxitems) or (itemno < 1) then exit; + ItemNoEdit.Text := IntToStr(itemno); + ShowEssayItem(self,itemno); +end; +//------------------------------------------------------------------- + +procedure TEssayFrm.ClearBtnClick(Sender: TObject); +begin + BMPFileEdit.Text := ''; + BMPImage.Visible := false; +end; +//------------------------------------------------------------------- + +procedure TEssayFrm.SymbolBoxClick(Sender: TObject); +var + index : integer; + S : string; +begin + if EditBox = 1 then + begin + index := SymbolBox.ItemIndex; + S := SymbolBox.Items.Strings[index]; + symbol := S[1]; + index := StemMemo.Lines.Count; + if index > 0 then + begin + S := StemMemo.Lines.Strings[index-1]; + StemMemo.Lines.Delete(index-1); + S := S + symbol; + StemMemo.Lines.Insert(index-1,S); + end + else begin + S := StemMemo.Lines.Strings[0]; + StemMemo.Lines.Delete(0); + S := S + symbol; + StemMemo.Lines.Add(S); + end; + end + else begin + index := SymbolBox.ItemIndex; + S := SymbolBox.Items.Strings[index]; + symbol := S[1]; + index := AnswerMemo.Lines.Count; + if index > 0 then + begin + S := AnswerMemo.Lines.Strings[index-1]; + AnswerMemo.Lines.Delete(index-1); + S := S + symbol; + AnswerMemo.Lines.Insert(index-1,S); + end + else begin + S := AnswerMemo.Lines.Strings[0]; + AnswerMemo.Lines.Delete(0); + S := S + symbol; + AnswerMemo.Lines.Add(S); + end; + end; +end; +//------------------------------------------------------------------- + +procedure TEssayFrm.StemMemoEnter(Sender: TObject); +begin + EditBox := 1; +end; +//------------------------------------------------------------------- + +procedure TEssayFrm.AnswerMemoEnter(Sender: TObject); +begin + EditBox := 2; +end; +//------------------------------------------------------------------- + +end. diff --git a/applications/lazstats/source/not used by LazStats/fileextractunit.lfm b/applications/lazstats/source/not used by LazStats/fileextractunit.lfm new file mode 100644 index 000000000..7a53b7d70 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/fileextractunit.lfm @@ -0,0 +1,248 @@ +object FileExtractFrm: TFileExtractFrm + Left = 441 + Height = 509 + Top = 271 + Width = 435 + HelpContext = 406 + HorzScrollBar.Page = 434 + VertScrollBar.Page = 508 + ActiveControl = NoFieldsEdit + Caption = 'File Extraction Procedure' + ClientHeight = 509 + ClientWidth = 435 + Font.Height = -11 + Font.Name = 'MS Sans Serif' + HelpFile = 'OS2Help.hlp' + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Label2: TLabel + Left = 8 + Height = 13 + Top = 152 + Width = 127 + Caption = 'Number of lines per record:' + ParentColor = False + end + object Label3: TLabel + Left = 224 + Height = 13 + Top = 152 + Width = 161 + Caption = 'No. of fields (variables) per record:' + ParentColor = False + end + object Label4: TLabel + Left = 8 + Height = 13 + Top = 176 + Width = 189 + Caption = 'Sequence number of key selection field:' + ParentColor = False + end + object Label5: TLabel + Left = 8 + Height = 13 + Top = 200 + Width = 196 + Caption = 'Selection Value (Including Dec. Fraction):' + ParentColor = False + WordWrap = True + end + object Label1: TLabel + Left = 272 + Height = 13 + Top = 424 + Width = 92 + Caption = 'Records Retrieved:' + ParentColor = False + end + object Label6: TLabel + Left = 8 + Height = 13 + Top = 424 + Width = 96 + Caption = 'Records Processed:' + ParentColor = False + end + object Memo1: TMemo + Left = 24 + Height = 113 + Top = 0 + Width = 377 + Lines.Strings = ( + 'This procedure is used to extract records from files too large to read directly ' + 'into the data grid. The data grid can hold about 100,000 records. If your file' + 'is larger but you will not be processing all records, you may extract sub-groups' + 'of records using a "key" field, e.g. a group identification number. The records' + 'extracted will be placed into the data grid as if you had entered them via the' + 'keyboard. You may then save the sub-file, process it, etc. as any other file. If' + 'you have multiple groups to extract, repeat pressing the Extract button until all' + 'sub-files you need are placed into the data grid. Press return to continue.' + ) + TabOrder = 4 + end + object NoLinesEdit: TEdit + Left = 144 + Height = 21 + Top = 152 + Width = 25 + TabOrder = 5 + end + object NoFieldsEdit: TEdit + Left = 392 + Height = 21 + Top = 152 + Width = 25 + TabOrder = 0 + end + object FormatGrp: TRadioGroup + Left = 272 + Height = 81 + Top = 176 + Width = 145 + AutoFill = True + Caption = 'Record Format:' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 63 + ClientWidth = 141 + Items.Strings = ( + 'Tab seperated fields' + 'comma seperated fields' + 'space seperated fields' + 'User specified format' + ) + OnClick = FormatGrpClick + TabOrder = 3 + end + object KeyVarNoEdit: TEdit + Left = 200 + Height = 21 + Top = 176 + Width = 25 + TabOrder = 1 + end + object ValueEdit: TEdit + Left = 112 + Height = 21 + Top = 208 + Width = 113 + TabOrder = 2 + end + object LabelsChk: TCheckBox + Left = 8 + Height = 19 + Top = 248 + Width = 207 + Caption = 'The first record contains variable labels.' + TabOrder = 6 + end + object FmtGrid: TStringGrid + Left = 8 + Height = 121 + Top = 296 + Width = 409 + ColCount = 6 + FixedCols = 0 + FixedRows = 0 + GridLineWidth = 0 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColMoving, goEditing, goTabs] + TabOrder = 7 + end + object CancelBtn: TButton + Left = 160 + Height = 25 + Top = 448 + Width = 57 + BorderSpacing.InnerBorder = 4 + Caption = 'Cancel' + ModalResult = 2 + OnClick = CancelBtnClick + TabOrder = 8 + end + object OKBtn: TButton + Left = 360 + Height = 25 + Top = 448 + Width = 57 + BorderSpacing.InnerBorder = 4 + Caption = 'Return' + ModalResult = 1 + OnClick = OKBtnClick + TabOrder = 9 + end + object ResetBtn: TButton + Left = 224 + Height = 25 + Top = 448 + Width = 57 + BorderSpacing.InnerBorder = 4 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 10 + end + object ExtractBtn: TButton + Left = 288 + Height = 25 + Top = 448 + Width = 65 + BorderSpacing.InnerBorder = 4 + Caption = 'Extract' + OnClick = ExtractBtnClick + TabOrder = 11 + end + object FileSelBtn: TButton + Left = 8 + Height = 25 + Top = 120 + Width = 201 + BorderSpacing.InnerBorder = 4 + Caption = 'Press to Select a Huge File for Extraction' + OnClick = FileSelBtnClick + TabOrder = 12 + end + object NoGotEdit: TEdit + Left = 368 + Height = 21 + Top = 424 + Width = 49 + TabOrder = 13 + Text = 'NoGotEdit' + end + object RecdReadEdit: TEdit + Left = 104 + Height = 21 + Top = 424 + Width = 65 + TabOrder = 14 + Text = 'RecdReadEdit' + end + object TypeBox: TComboBox + Left = 208 + Height = 21 + Top = 272 + Width = 57 + ItemHeight = 13 + Items.Strings = ( + '(I)nteger' + '(F)loating point' + '(S)tring' + '(M)oney' + '(D)ate' + ) + OnChange = TypeBoxChange + TabOrder = 15 + Text = 'Type' + end + object OpenDialog1: TOpenDialog + FilterIndex = 0 + left = 240 + top = 192 + end +end diff --git a/applications/lazstats/source/not used by LazStats/fileextractunit.lrs b/applications/lazstats/source/not used by LazStats/fileextractunit.lrs new file mode 100644 index 000000000..bc2a08dd0 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/fileextractunit.lrs @@ -0,0 +1,77 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TFileExtractFrm','FORMDATA',[ + 'TPF0'#15'TFileExtractFrm'#14'FileExtractFrm'#4'Left'#3#185#1#6'Height'#3#253 + +#1#3'Top'#3#15#1#5'Width'#3#179#1#11'HelpContext'#3#150#1#18'HorzScrollBar.P' + +'age'#3#178#1#18'VertScrollBar.Page'#3#252#1#13'ActiveControl'#7#12'NoFields' + +'Edit'#7'Caption'#6#25'File Extraction Procedure'#12'ClientHeight'#3#253#1#11 + +'ClientWidth'#3#179#1#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif' + +#8'HelpFile'#6#11'OS2Help.hlp'#6'OnShow'#7#8'FormShow'#10'LCLVersion'#6#7'2.' + +'1.0.0'#0#6'TLabel'#6'Label2'#4'Left'#2#8#6'Height'#2#13#3'Top'#3#152#0#5'Wi' + +'dth'#2#127#7'Caption'#6#27'Number of lines per record:'#11'ParentColor'#8#0 + +#0#6'TLabel'#6'Label3'#4'Left'#3#224#0#6'Height'#2#13#3'Top'#3#152#0#5'Width' + +#3#161#0#7'Caption'#6'%No. of fields (variables) per record:'#11'ParentColor' + +#8#0#0#6'TLabel'#6'Label4'#4'Left'#2#8#6'Height'#2#13#3'Top'#3#176#0#5'Width' + +#3#189#0#7'Caption'#6'''Sequence number of key selection field:'#11'ParentCo' + +'lor'#8#0#0#6'TLabel'#6'Label5'#4'Left'#2#8#6'Height'#2#13#3'Top'#3#200#0#5 + +'Width'#3#196#0#7'Caption'#6'*Selection Value (Including Dec. Fraction):'#11 + +'ParentColor'#8#8'WordWrap'#9#0#0#6'TLabel'#6'Label1'#4'Left'#3#16#1#6'Heigh' + +'t'#2#13#3'Top'#3#168#1#5'Width'#2'\'#7'Caption'#6#18'Records Retrieved:'#11 + +'ParentColor'#8#0#0#6'TLabel'#6'Label6'#4'Left'#2#8#6'Height'#2#13#3'Top'#3 + +#168#1#5'Width'#2'`'#7'Caption'#6#18'Records Processed:'#11'ParentColor'#8#0 + +#0#5'TMemo'#5'Memo1'#4'Left'#2#24#6'Height'#2'q'#3'Top'#2#0#5'Width'#3'y'#1 + +#13'Lines.Strings'#1#6'PThis procedure is used to extract records from files' + +' too large to read directly '#6'Pinto the data grid. The data grid can hol' + +'d about 100,000 records. If your file'#6'Pis larger but you will not be pr' + +'ocessing all records, you may extract sub-groups'#6'Pof records using a "ke' + +'y" field, e.g. a group identification number. The records'#6'Nextracted wi' + +'ll be placed into the data grid as if you had entered them via the'#6'Rkeyb' + +'oard. You may then save the sub-file, process it, etc. as any other file. ' + +' If'#6'Qyou have multiple groups to extract, repeat pressing the Extract bu' + +'tton until all'#6'Lsub-files you need are placed into the data grid. Press' + +' return to continue.'#0#8'TabOrder'#2#4#0#0#5'TEdit'#11'NoLinesEdit'#4'Left' + +#3#144#0#6'Height'#2#21#3'Top'#3#152#0#5'Width'#2#25#8'TabOrder'#2#5#0#0#5'T' + +'Edit'#12'NoFieldsEdit'#4'Left'#3#136#1#6'Height'#2#21#3'Top'#3#152#0#5'Widt' + +'h'#2#25#8'TabOrder'#2#0#0#0#11'TRadioGroup'#9'FormatGrp'#4'Left'#3#16#1#6'H' + +'eight'#2'Q'#3'Top'#3#176#0#5'Width'#3#145#0#8'AutoFill'#9#7'Caption'#6#14'R' + +'ecord Format:'#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSizing.TopBotto' + +'mSpacing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousChildResi' + +'ze'#27'ChildSizing.EnlargeVertical'#7#24'crsHomogenousChildResize'#28'Child' + +'Sizing.ShrinkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical' + +#7#14'crsScaleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBot' + +'tom'#27'ChildSizing.ControlsPerLine'#2#1#12'ClientHeight'#2'?'#11'ClientWid' + +'th'#3#141#0#13'Items.Strings'#1#6#20'Tab seperated fields'#6#22'comma seper' + +'ated fields'#6#22'space seperated fields'#6#21'User specified format'#0#7'O' + +'nClick'#7#14'FormatGrpClick'#8'TabOrder'#2#3#0#0#5'TEdit'#12'KeyVarNoEdit'#4 + +'Left'#3#200#0#6'Height'#2#21#3'Top'#3#176#0#5'Width'#2#25#8'TabOrder'#2#1#0 + +#0#5'TEdit'#9'ValueEdit'#4'Left'#2'p'#6'Height'#2#21#3'Top'#3#208#0#5'Width' + +#2'q'#8'TabOrder'#2#2#0#0#9'TCheckBox'#9'LabelsChk'#4'Left'#2#8#6'Height'#2 + +#19#3'Top'#3#248#0#5'Width'#3#207#0#7'Caption'#6'*The first record contains ' + +'variable labels.'#8'TabOrder'#2#6#0#0#11'TStringGrid'#7'FmtGrid'#4'Left'#2#8 + +#6'Height'#2'y'#3'Top'#3'('#1#5'Width'#3#153#1#8'ColCount'#2#6#9'FixedCols'#2 + +#0#9'FixedRows'#2#0#13'GridLineWidth'#2#0#7'Options'#11#15'goFixedVertLine' + +#15'goFixedHorzLine'#10'goVertLine'#10'goHorzLine'#11'goColMoving'#9'goEditi' + +'ng'#6'goTabs'#0#8'TabOrder'#2#7#0#0#7'TButton'#9'CancelBtn'#4'Left'#3#160#0 + +#6'Height'#2#25#3'Top'#3#192#1#5'Width'#2'9'#25'BorderSpacing.InnerBorder'#2 + +#4#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#7'OnClick'#7#14'CancelBtnClick' + +#8'TabOrder'#2#8#0#0#7'TButton'#5'OKBtn'#4'Left'#3'h'#1#6'Height'#2#25#3'Top' + +#3#192#1#5'Width'#2'9'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#6'Retu' + +'rn'#11'ModalResult'#2#1#7'OnClick'#7#10'OKBtnClick'#8'TabOrder'#2#9#0#0#7'T' + +'Button'#8'ResetBtn'#4'Left'#3#224#0#6'Height'#2#25#3'Top'#3#192#1#5'Width'#2 + +'9'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#5'Reset'#7'OnClick'#7#13 + +'ResetBtnClick'#8'TabOrder'#2#10#0#0#7'TButton'#10'ExtractBtn'#4'Left'#3' '#1 + +#6'Height'#2#25#3'Top'#3#192#1#5'Width'#2'A'#25'BorderSpacing.InnerBorder'#2 + +#4#7'Caption'#6#7'Extract'#7'OnClick'#7#15'ExtractBtnClick'#8'TabOrder'#2#11 + +#0#0#7'TButton'#10'FileSelBtn'#4'Left'#2#8#6'Height'#2#25#3'Top'#2'x'#5'Widt' + +'h'#3#201#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6'*Press to Select ' + +'a Huge File for Extraction'#7'OnClick'#7#15'FileSelBtnClick'#8'TabOrder'#2 + ,#12#0#0#5'TEdit'#9'NoGotEdit'#4'Left'#3'p'#1#6'Height'#2#21#3'Top'#3#168#1#5 + +'Width'#2'1'#8'TabOrder'#2#13#4'Text'#6#9'NoGotEdit'#0#0#5'TEdit'#12'RecdRea' + +'dEdit'#4'Left'#2'h'#6'Height'#2#21#3'Top'#3#168#1#5'Width'#2'A'#8'TabOrder' + +#2#14#4'Text'#6#12'RecdReadEdit'#0#0#9'TComboBox'#7'TypeBox'#4'Left'#3#208#0 + +#6'Height'#2#21#3'Top'#3#16#1#5'Width'#2'9'#10'ItemHeight'#2#13#13'Items.Str' + +'ings'#1#6#9'(I)nteger'#6#16'(F)loating point'#6#8'(S)tring'#6#7'(M)oney'#6#6 + +'(D)ate'#0#8'OnChange'#7#13'TypeBoxChange'#8'TabOrder'#2#15#4'Text'#6#4'Type' + +#0#0#11'TOpenDialog'#11'OpenDialog1'#11'FilterIndex'#2#0#4'left'#3#240#0#3't' + +'op'#3#192#0#0#0#0 +]); diff --git a/applications/lazstats/source/not used by LazStats/fileextractunit.pas b/applications/lazstats/source/not used by LazStats/fileextractunit.pas new file mode 100644 index 000000000..9468bb577 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/fileextractunit.pas @@ -0,0 +1,447 @@ +unit FileExtractUnit; + +{$MODE Delphi} + +interface + +uses + LCLIntf, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Grids, ExtCtrls, GLOBALS, OS3MainUnit, DATAPROCS, DICTIONARYUNIT, + LResources, Buttons; + +type + TFileExtractFrm = class(TForm) + Memo1: TMemo; + Label2: TLabel; + NoLinesEdit: TEdit; + Label3: TLabel; + NoFieldsEdit: TEdit; + FormatGrp: TRadioGroup; + Label4: TLabel; + KeyVarNoEdit: TEdit; + Label5: TLabel; + ValueEdit: TEdit; + LabelsChk: TCheckBox; + FmtGrid: TStringGrid; + CancelBtn: TButton; + OKBtn: TButton; + ResetBtn: TButton; + ExtractBtn: TButton; + OpenDialog1: TOpenDialog; + FileSelBtn: TButton; + Label1: TLabel; + NoGotEdit: TEdit; + Label6: TLabel; + RecdReadEdit: TEdit; + TypeBox: TComboBox; + procedure ResetBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure CancelBtnClick(Sender: TObject); + procedure FormatGrpClick(Sender: TObject); + procedure OKBtnClick(Sender: TObject); + procedure ExtractBtnClick(Sender: TObject); + procedure FileSelBtnClick(Sender: TObject); + procedure TypeBoxChange(Sender: TObject); + private + { Private declarations } + FileName : string; + + public + { Public declarations } + function GetValues(VAR TheFile : TextFile; + NoLines : integer; + NoFlds : integer; + Token : integer; + VAR StrValues : StrDyneVec) : boolean; + procedure PutGrid(RecdNo : integer; + NoFlds : integer; + LabelsFirst : boolean; + VAR StrValues : StrDyneVec); + function GetFmtValues(VAR TheFile : TextFile; + NoLines : integer; + NoFlds : integer; + VAR StrValues : StrDyneVec) : boolean; + end; + +var + FileExtractFrm: TFileExtractFrm; + +implementation + + +procedure TFileExtractFrm.ResetBtnClick(Sender: TObject); +begin + NoLinesEdit.Text := '1'; + NoFieldsEdit.Text := ''; + KeyVarNoEdit.Text := ''; + ValueEdit.Text := ''; + NoGotEdit.Text := ''; + RecdReadEdit.Text := ''; + FormatGrp.ItemIndex := 0; + LabelsChk.Checked := false; + FmtGrid.Cells[0,0] := 'Field'; + FmtGrid.Cells[1,0] := 'Start'; + FmtGrid.Cells[2,0] := 'End'; + FmtGrid.Cells[3,0] := 'Data Type'; + FmtGrid.Cells[4,0] := 'Line No.'; + FmtGrid.Cells[5,0] := 'Label'; + FmtGrid.Visible := false; + TypeBox.Text := 'Types'; + TypeBox.Visible := false; +end; +//-------------------------------------------------------- + +procedure TFileExtractFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; +//--------------------------------------------------------- + +procedure TFileExtractFrm.CancelBtnClick(Sender: TObject); +begin + FileExtractFrm.Hide; +end; +//-------------------------------------------------------------- + +procedure TFileExtractFrm.FormatGrpClick(Sender: TObject); +begin + if FormatGrp.ItemIndex = 3 then + begin + FmtGrid.RowCount := StrToInt(NoFieldsEdit.Text) + 1; + FmtGrid.Visible := true; + TypeBox.Visible := true; + end + else begin + FmtGrid.Visible := false; + TypeBox.Visible := false; + end; +end; +//------------------------------------------------------------- + +procedure TFileExtractFrm.OKBtnClick(Sender: TObject); +begin + FileExtractFrm.Hide; +end; +//--------------------------------------------------------------------- + +function TFileExtractFrm.GetValues(VAR TheFile : TextFile; + NoLines : integer; + NoFlds : integer; + Token : integer; + VAR StrValues : StrDyneVec) : boolean; +var + done, endline : boolean; + i, valcount : integer; + cellstring : string; + achar : char; + +begin + done := false; + valcount := 0; + + if not done then + begin + for i := 1 to NoLines do + begin + endline := false; + while not endline do + begin + read(TheFile,achar); + if EOF(TheFile) then + begin + done := true; + GetValues := done; + exit; + end; + if ord(achar) = 10 then continue; // ignore line feed + if ord(achar) <> 13 then // not a new line + begin + if ord(achar) <> Token then // not a tab character + cellstring := cellstring + achar + else + begin // Token character found - save string and bump counter + StrValues[valcount] := cellstring; + cellstring := ''; + valcount := valcount + 1; + end; + end // not a new line - tab or character found + else begin + endline := true; + StrValues[valcount] := cellstring; + valcount := valcount + 1; + cellstring := ''; + end; + end; // next line + end; // next line + end // net yet at eof + else done := true; + if valcount <> NoFlds then + begin + ShowMessage('ERROR! Mismatched no. fields - see grid for first record'); + FmtGrid.ColCount := valcount + 1; + FmtGrid.Visible := true; + for i := 1 to NoFlds do + FmtGrid.Cells[i-1,0] := StrValues[i-1]; + done := true; + end; + GetValues := done; +end; +//--------------------------------------------------------------------- + +procedure TFileExtractFrm.PutGrid(RecdNo : integer; + NoFlds : integer; + LabelsFirst : boolean; + VAR StrValues : StrDyneVec); +var + i : integer; + cellstring : string; + +begin + if LabelsFirst = true then + begin + OS3MainFrm.DataGrid.RowCount := 2; + OS3MainFrm.DataGrid.Cells[0,0] := 'Case 0'; + for i := 1 to NoFlds do OS3MainFrm.DataGrid.Cells[i,0] := StrValues[i-1]; + end + else + begin + OS3MainFrm.DataGrid.RowCount := RecdNo + 1; + cellstring := 'Case ' + IntToStr(RecdNo); + OS3MainFrm.DataGrid.Cells[0,RecdNo] := cellstring; + for i := 1 to NoFlds do OS3MainFrm.DataGrid.Cells[i,RecdNo] := StrValues[i-1]; + end; +end; +//--------------------------------------------------------------------- + +procedure TFileExtractFrm.ExtractBtnClick(Sender: TObject); +var + LabelsFirst : boolean; // first record contains variable labels + NoFlds : integer; // number of variables + NoLines : integer; // number of lines per record + FormatType : integer; // 1 = tab, 2 = comma, 3 = space, 4 = user spec. + KeyNo : integer; // sequence number of field containing the key + KeyValue : string; // value of the key field + TheFile : TextFile; // file handle + StrValues : StrDyneVec; // pointer to array of strings for record values + done : boolean; + NoRecords : integer; + Token : integer; // tab, comma or space charcter ordinal value + i, fldno : integer; + OldCursor : Tcursor; + NoRead : integer; // no. of records read from big file + fldtype : string; + cellstring : string; // for labels provided in the fmtgrid + +begin + // get entered values from the form + if LabelsChk.Checked then LabelsFirst := true else LabelsFirst := false; + NoFlds := StrToInt(NoFieldsEdit.Text); + NoLines := StrToInt(NoLinesEdit.Text); + FormatType := FormatGrp.ItemIndex + 1; + KeyNo := StrToInt(KeyVarNoEdit.Text); + KeyValue := ValueEdit.Text; + SetLength(StrValues,NoFlds + 1); + done := false; + NoRecords := 0; + Token := ord(' '); // default of a space + OldCursor := FileExtractFrm.Cursor; + NoRead := 0; + OS3MainFrm.DataGrid.ColCount := NoFlds + 1; + for i := 1 to NoFlds do + begin + DictionaryFrm.DictGrid.RowCount := i; + DictionaryFrm.Defaults(Self,i); + VarDefined[i] := true; + end; + + // open file for processing + AssignFile(TheFile,FileName); + Reset(TheFile); + + // process first (or second) record according to format type + case FormatType of + 1, 2, 3 : begin // tab seperated fields + FileExtractFrm.Cursor := crHourGlass; + if not LabelsFirst then + begin + // store labels (if not blank) into grid row 0 and type in defs. + for i := 1 to NoFlds do + begin + cellstring := format('VAR%2d',[i]); + OS3MainFrm.DataGrid.Cells[i,0] := cellstring; + end; + end; + while Not done do + begin + if FormatType = 1 then Token := 9; // tab character + if FormatType = 2 then Token := ord(','); // comma + if FormatType = 3 then Token := ord(' '); // space + done := GetValues(TheFile,NoLines,NoFlds,Token,StrValues); + if not done then + begin + NoRead := NoRead + 1; + if LabelsFirst then + begin + PutGrid(0,NoFlds,LabelsFirst,StrValues); + LabelsFirst := false; + end; + RecdReadEdit.Text := IntToStr(NoRead); + FileExtractFrm.Repaint; + StrValues[KeyNo-1] := Trim(StrValues[KeyNo-1]); + if StrValues[KeyNo-1] = KeyValue then // found group record + begin + NoRecords := NoRecords + 1; + PutGrid(NoRecords,NoFlds,LabelsFirst,StrValues); + NoGotEdit.Text := IntToStr(NoRecords); + end; + end; + end; + FileExtractFrm.Cursor := OldCursor; + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoRecords); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoFlds); + OS3MainFrm.RowEdit.Text := '1'; + OS3MainFrm.ColEdit.Text := '1'; + OS3MainFrm.DataGrid.Row := 1; + OS3MainFrm.DataGrid.Col := 1; + NoVariables := NoFlds; + NoCases := NoRecords; + end; + 4 : begin // user specified format + FileExtractFrm.Cursor := crHourGlass; + if not LabelsFirst then + begin + // store labels (if not blank) into grid row 0 and type in defs. + for i := 1 to NoFlds do + begin + fldno := StrToInt(FmtGrid.Cells[0,i]); + fldtype := FmtGrid.Cells[3,fldno]; + DictionaryFrm.DictGrid.Cells[4,fldno] := fldtype[2]; + cellstring := FmtGrid.Cells[5,fldno]; + DictionaryFrm.DictGrid.Cells[1,fldno] := cellstring; + DictionaryFrm.DictGrid.Cells[2,fldno] := cellstring; + if cellstring <> '' then OS3MainFrm.DataGrid.Cells[i,0] := cellstring; + end; + end; + while NOT done do + begin + done := GetFmtValues(TheFile,NoLines,NoFlds,StrValues); + if not done then + begin + NoRead := NoRead + 1; + if LabelsFirst then + begin + PutGrid(0,NoFlds,LabelsFirst,StrValues); + LabelsFirst := false; + end; + RecdReadEdit.Text := IntToStr(NoRead); + FileExtractFrm.Repaint; + StrValues[KeyNo-1] := Trim(StrValues[KeyNo-1]); + if StrValues[KeyNo-1] = KeyValue then // found group record + begin + NoRecords := NoRecords + 1; + PutGrid(NoRecords,NoFlds,LabelsFirst,StrValues); + NoGotEdit.Text := IntToStr(NoRecords); + end; + end; // if not done + end; // while not done + FileExtractFrm.Cursor := OldCursor; + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoRecords); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoFlds); + OS3MainFrm.RowEdit.Text := '1'; + OS3MainFrm.ColEdit.Text := '1'; + OS3MainFrm.DataGrid.Row := 1; + OS3MainFrm.DataGrid.Col := 1; + NoVariables := NoFlds; + NoCases := NoRecords; + end; // end case 4 (formatted input) + end; // end case switch + StrValues := nil; + CloseFile(TheFile); +end; +//------------------------------------------------------------------------ + +procedure TFileExtractFrm.FileSelBtnClick(Sender: TObject); +begin + OpenDialog1.Filter := 'Tab field files (*.tab)|*.TAB|Text files (*.txt)|*.TXT|All files (*.*)|*.*'; + OpenDialog1.FilterIndex := 1; + OpenDialog1.DefaultExt := 'TAB'; + if OpenDialog1.Execute then FileName := OpenDialog1.FileName + else ShowMessage('Error in opening File!'); +end; +//------------------------------------------------------------------------- + +function TFileExtractFrm.GetFmtValues(VAR TheFile : TextFile; + NoLines : integer; + NoFlds : integer; + VAR StrValues : StrDyneVec) : boolean; +var + done, endline : boolean; + i, j, endat, startat, stlong, valcount, fldno : integer; + LineStr : string; + achar : char; + +begin + done := false; + valcount := 0; + + if not done then + begin + for i := 1 to NoLines do + begin + endline := false; + while not endline do + begin + read(TheFile,achar); + if EOF(TheFile) then + begin + done := true; + GetFmtValues := done; + exit; + end; + if ord(achar) = 10 then continue; // ignore line feed + if ord(achar) <> 13 then LineStr := LineStr + achar + else endline := true; + end; + // now, parse values in this line + for j := 1 to NoFlds do + begin + if StrToInt(FmtGrid.Cells[4,j]) <> i then continue; // in line i? + startat := StrToInt(FmtGrid.Cells[1,j]); + endat := StrToInt(FmtGrid.Cells[2,j]); + stlong := endat - startat + 1; + fldno := StrToInt(FmtGrid.Cells[0,j]); + StrValues[fldno-1] := Copy(LineStr,startat,stlong); + valcount := valcount + 1; + end; // next j + LineStr := ''; + end; // next line + end // not yet at eof + else done := true; + if valcount <> NoFlds then + begin + ShowMessage('ERROR! Mismatched no. fields and actual record data.'); + done := true; + end; + GetFmtValues := done; +end; +//----------------------------------------------------------------------- + +procedure TFileExtractFrm.TypeBoxChange(Sender: TObject); +var + index : integer; + row, col : integer; + +begin + index := TypeBox.ItemIndex; + row := FmtGrid.Row; + col := FmtGrid.Col; + FmtGrid.Cells[col,row] := IntToStr(index); +end; + +//------------------------------------------------------------------------- + +initialization + {$i fileextractunit.lrs} + {$i FILEEXTRACTUNIT.lrs} + +end. diff --git a/applications/lazstats/source/not used by LazStats/frmmain.lfm b/applications/lazstats/source/not used by LazStats/frmmain.lfm new file mode 100644 index 000000000..207bc4c6b --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/frmmain.lfm @@ -0,0 +1,919 @@ +object PicViewFrm: TPicViewFrm + Left = 0 + Height = 0 + Top = 716 + Width = 0 + HorzScrollBar.Page = 871 + HorzScrollBar.Range = 165 + VertScrollBar.Page = 615 + VertScrollBar.Range = 23 + ActiveControl = LBFiles + Caption = 'Image viewer' + ClientHeight = 0 + ClientWidth = 0 + Font.Height = -13 + Font.Name = 'MS Sans Serif' + Menu = MainMenu1 + OnKeyDown = FormKeyDown + OnShow = FormShow + LCLVersion = '0.9.28.2' + object SPImage: TSplitter + Left = 161 + Height = 0 + Top = 23 + Width = 4 + Beveled = True + end + object ToolBar1: TToolBar + Left = 0 + Height = 29 + Top = 0 + Width = 165 + ButtonHeight = 23 + Caption = 'ToolBar1' + Images = ILMain + ParentShowHint = False + ShowHint = True + TabOrder = 0 + object TBOPen: TToolButton + Left = 1 + Top = 2 + Action = AOpen + end + object TBOpenDir: TToolButton + Left = 24 + Top = 2 + Action = AOpenDir + end + object TBOpenDirRec: TToolButton + Left = 47 + Top = 2 + Action = OpenDirRecursively + end + object ToolButton4: TToolButton + Left = 70 + Top = 2 + Width = 8 + Caption = 'ToolButton4' + ImageIndex = 3 + Style = tbsSeparator + end + object TBPRev: TToolButton + Left = 78 + Top = 2 + Action = APreviousImage + end + object TBNext: TToolButton + Left = 101 + Top = 2 + Action = ANextImage + end + object TBPRevDir: TToolButton + Left = 124 + Top = 2 + Action = APrevImageDir + end + object TBNextDir: TToolButton + Left = 1 + Top = 25 + Action = ANextImageDir + end + object TBDoubleSize: TToolButton + Left = 24 + Top = 25 + Action = ADoubleSize + end + object TBHalfSize: TToolButton + Left = 47 + Top = 25 + Action = AHalfSize + end + object ToolButton3: TToolButton + Left = 70 + Top = 25 + Width = 8 + Caption = 'ToolButton3' + ImageIndex = 10 + Style = tbsSeparator + end + end + object LBFiles: TListBox + Left = 0 + Height = 0 + Top = 23 + Width = 161 + Align = alLeft + ClickOnSelChange = False + Font.Color = clBlack + Font.Height = 15 + Font.Name = 'Arial' + Font.Pitch = fpVariable + ItemHeight = 0 + OnClick = LBFilesClick + OnKeyDown = FormKeyDown + ParentFont = False + TabOrder = 1 + end + object PImage: TPanel + Left = 165 + Height = 0 + Top = 23 + Width = 0 + Align = alClient + ClientHeight = 0 + ClientWidth = 0 + FullRepaint = False + TabOrder = 2 + object ScrollBox1: TScrollBox + Left = 0 + Height = 0 + Top = 0 + Width = 0 + Align = alClient + BorderStyle = bsNone + ClientHeight = 0 + ClientWidth = 0 + TabOrder = 0 + object IMain: TImage + Left = 0 + Height = 0 + Top = 0 + Width = 0 + Align = alClient + Transparent = True + end + end + end + object MainMenu1: TMainMenu + Images = ILMain + left = 32 + top = 32 + object File1: TMenuItem + Caption = '&File' + object MIOpen: TMenuItem + Action = AOpen + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF292429FF4A48 + 4AFF524C52FF4A4C4AFF524C52FF4A4C4AFF524C52FF4A484AFF4A444AFF4140 + 41FF393439FF202020FF808080FF808080FF808080FF808080FF18304AFFC5BE + C5FFA4A5A4FFACAEACFFACAEACFFB4B2B4FFACAAACFFACAAACFF9C999CFF9495 + 9CFF8B8D8BFF4A484AFF808080FF808080FF808080FF808080FF203452FF5255 + 5AFFD5D2D5FFBDBEC5FFCDC6CDFFCDC6CDFFCDC6CDFFC5C2C5FFB4B2B4FFA4A5 + ACFFA4A1A4FF737173FF181418FF808080FF808080FF808080FF18304AFF1830 + 4AFFCDCECDFFCDCECDFFD5D6D5FFDED6DEFFD5D2D5FFD5CED5FFBDBABDFFB4B2 + B4FFA4A1A4FF9C959CFF4A484AFF808080FF808080FF808080FF203452FF417D + BDFF52555AFFDEDADEFFE6DEE6FFE6E2E6FFE6E2E6FFDED6DEFFC5C6C5FFB4B6 + BDFFACAEB4FFA4A1A4FF6A696AFF202020FF808080FF808080FF18304AFF83C6 + FFFF18304AFF808080FFDEDEE6FFEEEAEEFFE6E6E6FFE6E2E6FFC5C6CDFFBDBE + BDFFACAEACFFA4A1A4FF949594FF4A484AFF808080FF808080FF203452FF83C2 + FFFF5289CDFF4A5052FFFFFAFFFFFFF6FFFFF6EEF6FFE6E6E6FFDED6DEFFCDCE + CDFFCDC6CDFFBDBEBDFFBDBABDFFB4B6B4FF313031FF808080FF18304AFF9CD6 + FFFF8BC6FFFF83C6FFFF62AEFFFF62AEFFFF62AEFFFF62AEFFFF62AEFFFF62AE + FFFF62AEFFFF000000FF808080FF808080FF808080FF808080FF203452FF6AA5 + E6FFA4D6FFFF8BC6FFFF6AAAEEFF183452FF203452FF183452FF203452FF1834 + 52FF203452FF808080FF808080FF808080FF808080FF808080FF808080FF2034 + 52FF18304AFF183452FF18304AFF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF0000 + 00FF000000FF000000FF000000FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FF000000FF000000FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF000000FF808080FF808080FF808080FF808080FF0000 + 00FF000000FF000000FF000000FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF000000FF000000FF808080FF000000FF0000 + 00FF000000FF808080FF000000FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF000000FF000000FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF + } + OnClick = AOpenExecute + end + object MIOPenDir: TMenuItem + Action = AOpenDir + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF808080FF808080FF808080FF8080 + 80FF000000FF808080FF00FFFFFF808080FF00FFFFFF808080FF00FFFFFF8080 + 80FF00FFFFFF808080FF00FFFFFF000000FF808080FF808080FF808080FF8080 + 80FF000000FF00FFFFFF808080FF00FFFFFF830000FF00FFFFFF830000FF00FF + FFFF830000FF00FFFFFF808080FF000000FF808080FF808080FF808080FF8080 + 80FF000000FF808080FF00FFFFFF808080FF00FFFFFF830000FF830000FF8300 + 00FF00FFFFFF808080FF00FFFFFF000000FF808080FF808080FF808080FF8080 + 80FF000000FF00FFFFFF808080FF00FFFFFF830000FF830000FF00FFFFFF8300 + 00FF830000FF00FFFFFF808080FF000000FF808080FF808080FF808080FF8080 + 80FF000000FF808080FF00FFFFFF808080FF00FFFFFF830000FF830000FF8300 + 00FF00FFFFFF808080FF00FFFFFF000000FF808080FF808080FF808080FF8080 + 80FF000000FF00FFFFFF808080FF00FFFFFF830000FF00FFFFFF830000FF00FF + FFFF830000FF00FFFFFF808080FF000000FF808080FF808080FF808080FF8080 + 80FF000000FF808080FF00FFFFFF808080FF00FFFFFF808080FF00FFFFFF8080 + 80FF00FFFFFF808080FF00FFFFFF000000FF808080FF808080FF808080FF8080 + 80FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF00FFFFFF808080FF00FFFFFF808080FF000000FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF000000FF000000FF000000FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF + } + OnClick = AOpenDirExecute + end + object MIOpenDirRec: TMenuItem + Action = OpenDirRecursively + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000808080FF8385 + 83FF000808FF808080FF000000FF101010FF000000FF000408FF000000FF0004 + 08FF000000FF808080FF808080FF808080FF808080FF808080FF808080FF8B89 + 8BFF808080FFCDBEC5FFDECED5FFC5B2B4FFE6D2DEFFCDC6CDFFC5C2C5FFC5C6 + C5FF000000FF808080FF808080FF808080FF808080FF808080FF808080FF948D + 8BFFFFFAFFFFD5C6CDFFDECACDFFE6CED5FFD5BEBDFFD5C6CDFFCDC6C5FFDED2 + D5FF080000FF808080FF808080FF808080FF808080FF808080FF808080FF7B7D + 7BFF808080FFCDCECDFFD5CED5FFC5BABDFFDECED5FFDEC6CDFFE6CED5FFD5BE + C5FF100000FF080000FF201010FF808080FF808080FF808080FF808080FF838D + 8BFF808080FFC5C6C5FFC5CACDFFCDCACDFFCDCACDFFD5C2C5FFDECACDFFD5C2 + C5FF080000FFE6DADEFF000000FF808080FF808080FF808080FF808080FF7B85 + 83FF808080FFC5C6C5FFCDD2D5FFCDCECDFFCDC6CDFFCDCACDFFC5C2C5FFC5CA + C5FF000400FFB4BEBDFF000800FF808080FF808080FF808080FF808080FF8B89 + 8BFFFFFAFFFF808080FF808080FF808080FF808080FFFFFAFFFF808080FFFFFA + FFFF000000FFC5CECDFF000000FF000400FF000000FF808080FF808080FF9C81 + 83FF18008BFF10008BFF1800D5FF1000CDFF1800FFFF1000FFFF1800FFFF1000 + FFFF200808FFD5C6CDFF080000FFCDCACDFF000400FF808080FF808080FF9C81 + 83FF948983FF9C898BFF948983FF9C898BFF948983FF9C898BFF948983FF9C89 + 8BFF200000FFF6CED5FF100000FFD5CACDFF000000FF808080FF808080FF8080 + 80FF808080FFAC7D83FFFFFAFFFFFFF2FFFFFFFAFFFFFFF6FFFFFFFAFFFFFFFA + FFFF808080FFFFF2F6FF200000FFDEC2C5FF100008FF808080FF808080FF8080 + 80FF808080FFAC8D94FF10008BFF18008BFF1000CDFF1000D5FF1000FFFF1800 + FFFF1000FFFF1000FFFF180000FFD5C2C5FF080000FF808080FF808080FF8080 + 80FF808080FF83797BFF948183FF9C858BFF9C858BFF948983FF9C898BFF9485 + 83FF94898BFF837D7BFF080400FFDED6D5FF000400FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF94898BFFFFFAFFFF808080FF808080FFFFFA + F6FF808080FF808080FFFFFAF6FF808080FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF9C898BFF18008BFF10008BFF1800D5FF1000 + CDFF1800FFFF1000FFFF1800FFFF1000FFFF180000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF947D83FF9C8183FF9C898BFF948983FF9C89 + 8BFF948983FF9C898BFF948983FF9C898BFF100000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF + } + OnClick = OpenDirRecursivelyExecute + end + object MIClear: TMenuItem + Action = AClear + OnClick = AClearExecute + end + object N1: TMenuItem + Caption = '-' + end + object MIQuit: TMenuItem + Action = AExit + OnClick = AExitExecute + end + end + object MImage: TMenuItem + Caption = '&Image' + object D1: TMenuItem + Action = ADoubleSize + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF000000FF000000FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF000000FF000000FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF000000FF000000FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FF000000FF000000FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF838183FF000000FF000000FF000000FF838183FF808080FF00FF + FFFF838183FF000000FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FF838183FF837D83FF838183FF7B7D7BFF838183FF000000FF0000 + 00FF00FFFFFF808080FF808080FF808080FF808080FF808080FF808080FF0000 + 00FF838183FF808080FFC5C2C5FF808080FFC5C2C5FF808080FF838183FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF7B7D7BFF8381 + 83FF808080FFC5C2C5FF808080FF0000FFFF808080FFC5C2C5FF808080FF8381 + 83FF837D83FF808080FF808080FF808080FF808080FF808080FF000000FF8381 + 83FFC5C2C5FF808080FFC5C2C5FF0000FFFFC5C2C5FF808080FFC5C2C5FF8381 + 83FF000000FF808080FF808080FF808080FF808080FF808080FF000000FF8381 + 83FF808080FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF808080FF8381 + 83FF000000FF808080FF808080FF808080FF808080FF808080FF000000FF8381 + 83FFC5C2C5FF808080FFC5C2C5FF0000FFFFC5C2C5FF808080FFC5C2C5FF8381 + 83FF000000FF808080FF808080FF808080FF808080FF808080FF7B7D7BFF8381 + 83FF808080FFC5C2C5FF808080FF0000FFFF808080FFC5C2C5FF808080FF8381 + 83FF837D83FF808080FF808080FF808080FF808080FF808080FF808080FF0000 + 00FF838183FF808080FFC5C2C5FF808080FFC5C2C5FF808080FF838183FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FF838183FF837D83FF838183FF7B7D7BFF838183FF000000FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF838183FF000000FF000000FF000000FF838183FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF + } + OnClick = ADoubleSizeExecute + end + object MIHalfSize: TMenuItem + Action = AHalfSize + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF000000FF000000FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF000000FF000000FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF000000FF000000FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FF000000FF000000FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF838183FF000000FF000000FF000000FF838183FF808080FF00FF + FFFF838183FF000000FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FF838183FF837D83FF838183FF7B7D7BFF838183FF000000FF0000 + 00FF00FFFFFF808080FF808080FF808080FF808080FF808080FF808080FF0000 + 00FF838183FFC5C2C5FF808080FFC5C2C5FF808080FFC5C2C5FF838183FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF7B7D7BFF8381 + 83FFC5BEC5FF808080FFBDBEBDFF808080FFC5BEC5FF808080FFBDBEBDFF8381 + 83FF837D83FF808080FF808080FF808080FF808080FF808080FF000000FF8381 + 83FF808080FFC5C2C5FF808080FFC5C2C5FF808080FFC5C2C5FF808080FF8381 + 83FF000000FF808080FF808080FF808080FF808080FF808080FF000000FF8381 + 83FFBDBEBDFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFFC5BEC5FF8381 + 83FF000000FF808080FF808080FF808080FF808080FF808080FF000000FF8381 + 83FF808080FFC5C2C5FF808080FFC5C2C5FF808080FFC5C2C5FF808080FF8381 + 83FF000000FF808080FF808080FF808080FF808080FF808080FF7B7D7BFF8381 + 83FFC5BEC5FF808080FFBDBEBDFF808080FFC5BEC5FF808080FFBDBEBDFF8381 + 83FF837D83FF808080FF808080FF808080FF808080FF808080FF808080FF0000 + 00FF838183FFC5C2C5FF808080FFC5C2C5FF808080FFC5C2C5FF838183FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FF838183FF837D83FF838183FF7B7D7BFF838183FF000000FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF838183FF000000FF000000FF000000FF838183FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF + } + OnClick = AHalfSizeExecute + end + object N2: TMenuItem + Caption = '-' + end + object MINextImage: TMenuItem + Action = ANextImage + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF0000FFFF000000FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF0000FFFF0000FFFF0000 + FFFF000000FF000000FF808080FF808080FF808080FF808080FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF0000FFFF0000FFFF0000 + FFFF0000FFFF0000FFFF000000FF000000FF808080FF808080FF000000FF0000 + FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000 + FFFF0000FFFF0000FFFF0000FFFF0000FFFF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF0000FFFF0000FFFF0000 + FFFF0000FFFF0000FFFF000000FF000000FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF0000FFFF0000FFFF0000 + FFFF000000FF000000FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF0000FFFF000000FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF + } + ShortCut = 36882 + OnClick = ANextImageExecute + end + object PreviousImage1: TMenuItem + Action = APreviousImage + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF000000FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF000000FF0000FFFF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF000000FF000000FF0000FFFF0000FFFF0000FFFF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FF000000FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000 + FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF000000FF808080FF8080 + 80FF000000FF000000FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF808080FF8080 + 80FF808080FF808080FF000000FF000000FF0000FFFF0000FFFF0000FFFF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF000000FF0000FFFF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF000000FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF + } + ShortCut = 36884 + OnClick = APreviousImageExecute + end + object Nextimagedirectory1: TMenuItem + Action = ANextImageDir + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF808080FFFFFF00FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF838183FF838183FF838183FF838183FF838183FF838183FF8381 + 83FF838183FF838183FF838183FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF7B7D7BFF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF838183FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF000000FF000000FF808080FF000000FF8080 + 80FF808080FF808080FF837D83FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF000000FF000000FF808080FF000000FF0000 + 00FF808080FF808080FF838183FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF000000FF000000FF808080FF000000FF0000 + 00FF000000FF808080FF7B7D7BFF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF000000FF000000FF808080FF000000FF0000 + 00FF808080FF808080FF838183FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF000000FF000000FF808080FF000000FF8080 + 80FF808080FF808080FF837D83FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF838183FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF7B7D7BFF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FFFFFF00FF808080FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF808080FF + } + OnClick = ANextImageDirExecute + end + object Previousimagedirectory1: TMenuItem + Action = APrevImageDir + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF808080FFFFFF00FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF838183FF838183FF838183FF838183FF838183FF838183FF8381 + 83FF838183FF838183FF838183FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF7B7D7BFF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF838183FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF808080FF000000FF808080FF000000FF0000 + 00FF808080FF808080FF837D83FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF000000FF000000FF808080FF000000FF0000 + 00FF808080FF808080FF838183FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF000000FF000000FF000000FF808080FF000000FF0000 + 00FF808080FF808080FF7B7D7BFF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF000000FF000000FF808080FF000000FF0000 + 00FF808080FF808080FF838183FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF808080FF000000FF808080FF000000FF0000 + 00FF808080FF808080FF837D83FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF838183FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF7B7D7BFF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF000000FFFFFF00FF808080FFFFFF00FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FFFFFF00FF808080FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF808080FF + } + OnClick = APrevImageDirExecute + end + end + end + object ActionList1: TActionList + Images = ILMain + left = 72 + top = 32 + object AOpen: TAction + Caption = '&Open' + HelpType = htKeyword + ImageIndex = 0 + OnExecute = AOpenExecute + ShortCut = 16463 + end + object AOpenDir: TAction + Caption = 'Open &Directory' + HelpType = htKeyword + ImageIndex = 1 + OnExecute = AOpenDirExecute + ShortCut = 16452 + end + object AExit: TAction + Caption = '&Quit' + HelpType = htKeyword + OnExecute = AExitExecute + ShortCut = 16465 + end + object AClear: TAction + Caption = '&Clear list' + HelpType = htKeyword + OnExecute = AClearExecute + ShortCut = 16460 + end + object OpenDirRecursively: TAction + Caption = 'Open Directory &Recursively' + HelpType = htKeyword + ImageIndex = 2 + OnExecute = OpenDirRecursivelyExecute + ShortCut = 16466 + end + object ADoubleSize: TAction + Caption = '&Double size' + HelpType = htKeyword + ImageIndex = 5 + OnExecute = ADoubleSizeExecute + ShortCut = 16427 + end + object AHalfSize: TAction + Caption = '&Half Size' + HelpType = htKeyword + ImageIndex = 6 + OnExecute = AHalfSizeExecute + ShortCut = 16429 + end + object ANextImage: TAction + Caption = '&Next image' + HelpType = htKeyword + ImageIndex = 4 + OnExecute = ANextImageExecute + end + object APreviousImage: TAction + Caption = '&Previous Image' + HelpType = htKeyword + ImageIndex = 3 + OnExecute = APreviousImageExecute + end + object ANextImageDir: TAction + Caption = 'N&ext image directory' + HelpType = htKeyword + ImageIndex = 8 + OnExecute = ANextImageDirExecute + ShortCut = 32846 + end + object APrevImageDir: TAction + Caption = 'Pre&vious image directory' + HelpType = htKeyword + Hint = 'Jump to last image of previous directory' + ImageIndex = 7 + OnExecute = APrevImageDirExecute + ShortCut = 32848 + end + end + object ILMain: TImageList + left = 32 + top = 64 + Bitmap = { + 4C69090000001000000010000000808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF000000FF000000FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FF000000FF808080FF000000FF000000FF000000FF808080FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF0000 + 00FF808080FF808080FF808080FF808080FF000000FF000000FF000000FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF000000FF000000FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF000000FF000000FF0000 + 00FF808080FF808080FF808080FF808080FF203452FF18304AFF183452FF1830 + 4AFF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF203452FF6AA5E6FFA4D6FFFF8BC6FFFF6AAA + EEFF183452FF203452FF183452FF203452FF183452FF203452FF808080FF8080 + 80FF808080FF808080FF808080FF18304AFF9CD6FFFF8BC6FFFF83C6FFFF62AE + FFFF62AEFFFF62AEFFFF62AEFFFF62AEFFFF62AEFFFF62AEFFFF000000FF8080 + 80FF808080FF808080FF808080FF203452FF83C2FFFF5289CDFF4A5052FFFFFA + FFFFFFF6FFFFF6EEF6FFE6E6E6FFDED6DEFFCDCECDFFCDC6CDFFBDBEBDFFBDBA + BDFFB4B6B4FF313031FF808080FF18304AFF83C6FFFF18304AFF808080FFDEDE + E6FFEEEAEEFFE6E6E6FFE6E2E6FFC5C6CDFFBDBEBDFFACAEACFFA4A1A4FF9495 + 94FF4A484AFF808080FF808080FF203452FF417DBDFF52555AFFDEDADEFFE6DE + E6FFE6E2E6FFE6E2E6FFDED6DEFFC5C6C5FFB4B6BDFFACAEB4FFA4A1A4FF6A69 + 6AFF202020FF808080FF808080FF18304AFF18304AFFCDCECDFFCDCECDFFD5D6 + D5FFDED6DEFFD5D2D5FFD5CED5FFBDBABDFFB4B2B4FFA4A1A4FF9C959CFF4A48 + 4AFF808080FF808080FF808080FF203452FF52555AFFD5D2D5FFBDBEC5FFCDC6 + CDFFCDC6CDFFCDC6CDFFC5C2C5FFB4B2B4FFA4A5ACFFA4A1A4FF737173FF1814 + 18FF808080FF808080FF808080FF18304AFFC5BEC5FFA4A5A4FFACAEACFFACAE + ACFFB4B2B4FFACAAACFFACAAACFF9C999CFF94959CFF8B8D8BFF4A484AFF8080 + 80FF808080FF808080FF808080FF292429FF4A484AFF524C52FF4A4C4AFF524C + 52FF4A4C4AFF524C52FF4A484AFF4A444AFF414041FF393439FF202020FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF0000 + 00FF000000FF000000FF000000FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF000000FF00FF + FFFF808080FF00FFFFFF808080FF000000FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF808080FF808080FF808080FF808080FF000000FF808080FF00FF + FFFF808080FF00FFFFFF808080FF00FFFFFF808080FF00FFFFFF808080FF00FF + FFFF000000FF808080FF808080FF808080FF808080FF000000FF00FFFFFF8080 + 80FF00FFFFFF830000FF00FFFFFF830000FF00FFFFFF830000FF00FFFFFF8080 + 80FF000000FF808080FF808080FF808080FF808080FF000000FF808080FF00FF + FFFF808080FF00FFFFFF830000FF830000FF830000FF00FFFFFF808080FF00FF + FFFF000000FF808080FF808080FF808080FF808080FF000000FF00FFFFFF8080 + 80FF00FFFFFF830000FF830000FF00FFFFFF830000FF830000FF00FFFFFF8080 + 80FF000000FF808080FF808080FF808080FF808080FF000000FF808080FF00FF + FFFF808080FF00FFFFFF830000FF830000FF830000FF00FFFFFF808080FF00FF + FFFF000000FF808080FF808080FF808080FF808080FF000000FF00FFFFFF8080 + 80FF00FFFFFF830000FF00FFFFFF830000FF00FFFFFF830000FF00FFFFFF8080 + 80FF000000FF808080FF808080FF808080FF808080FF000000FF808080FF00FF + FFFF808080FF00FFFFFF808080FF00FFFFFF808080FF00FFFFFF808080FF00FF + FFFF000000FF808080FF808080FF808080FF808080FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF947D83FF9C8183FF9C898BFF948983FF9C898BFF948983FF9C898BFF9489 + 83FF9C898BFF100000FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF9C898BFF18008BFF10008BFF1800D5FF1000CDFF1800FFFF1000FFFF1800 + FFFF1000FFFF180000FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF94898BFFFFFAFFFF808080FF808080FFFFFAF6FF808080FF808080FFFFFA + F6FF808080FF000000FF808080FF808080FF808080FF808080FF83797BFF9481 + 83FF9C858BFF9C858BFF948983FF9C898BFF948583FF94898BFF837D7BFF0804 + 00FFDED6D5FF000400FF808080FF808080FF808080FF808080FFAC8D94FF1000 + 8BFF18008BFF1000CDFF1000D5FF1000FFFF1800FFFF1000FFFF1000FFFF1800 + 00FFD5C2C5FF080000FF808080FF808080FF808080FF808080FFAC7D83FFFFFA + FFFFFFF2FFFFFFFAFFFFFFF6FFFFFFFAFFFFFFFAFFFF808080FFFFF2F6FF2000 + 00FFDEC2C5FF100008FF808080FF808080FF9C8183FF948983FF9C898BFF9489 + 83FF9C898BFF948983FF9C898BFF948983FF9C898BFF200000FFF6CED5FF1000 + 00FFD5CACDFF000000FF808080FF808080FF9C8183FF18008BFF10008BFF1800 + D5FF1000CDFF1800FFFF1000FFFF1800FFFF1000FFFF200808FFD5C6CDFF0800 + 00FFCDCACDFF000400FF808080FF808080FF8B898BFFFFFAFFFF808080FF8080 + 80FF808080FF808080FFFFFAFFFF808080FFFFFAFFFF000000FFC5CECDFF0000 + 00FF000400FF000000FF808080FF808080FF7B8583FF808080FFC5C6C5FFCDD2 + D5FFCDCECDFFCDC6CDFFCDCACDFFC5C2C5FFC5CAC5FF000400FFB4BEBDFF0008 + 00FF808080FF808080FF808080FF808080FF838D8BFF808080FFC5C6C5FFC5CA + CDFFCDCACDFFCDCACDFFD5C2C5FFDECACDFFD5C2C5FF080000FFE6DADEFF0000 + 00FF808080FF808080FF808080FF808080FF7B7D7BFF808080FFCDCECDFFD5CE + D5FFC5BABDFFDECED5FFDEC6CDFFE6CED5FFD5BEC5FF100000FF080000FF2010 + 10FF808080FF808080FF808080FF808080FF948D8BFFFFFAFFFFD5C6CDFFDECA + CDFFE6CED5FFD5BEBDFFD5C6CDFFCDC6C5FFDED2D5FF080000FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF8B898BFF808080FFCDBEC5FFDECE + D5FFC5B2B4FFE6D2DEFFCDC6CDFFC5C2C5FFC5C6C5FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF838583FF000808FF808080FF0000 + 00FF101010FF000000FF000408FF000000FF000408FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF000000FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF000000FF0000FFFF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF0000 + 00FF000000FF0000FFFF0000FFFF0000FFFF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF000000FF000000FF0000 + FFFF0000FFFF0000FFFF0000FFFF0000FFFF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF0000FFFF0000FFFF0000 + FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000 + FFFF0000FFFF0000FFFF000000FF808080FF808080FF000000FF000000FF0000 + FFFF0000FFFF0000FFFF0000FFFF0000FFFF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF808080FF808080FF808080FF808080FF0000 + 00FF000000FF0000FFFF0000FFFF0000FFFF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF000000FF0000FFFF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF000000FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF000000FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF0000FFFF000000FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF0000FFFF0000FFFF0000FFFF000000FF000000FF8080 + 80FF808080FF808080FF808080FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000 + 00FF000000FF808080FF808080FF000000FF0000FFFF0000FFFF0000FFFF0000 + FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000 + FFFF0000FFFF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000 + 00FF000000FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF0000FFFF0000FFFF0000FFFF000000FF000000FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF0000FFFF000000FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF000000FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF838183FF0000 + 00FF000000FF000000FF838183FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF000000FF838183FF837D + 83FF838183FF7B7D7BFF838183FF000000FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF838183FF808080FFC5C2 + C5FF808080FFC5C2C5FF808080FF838183FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF7B7D7BFF838183FF808080FFC5C2C5FF8080 + 80FF0000FFFF808080FFC5C2C5FF808080FF838183FF837D83FF808080FF8080 + 80FF808080FF808080FF808080FF000000FF838183FFC5C2C5FF808080FFC5C2 + C5FF0000FFFFC5C2C5FF808080FFC5C2C5FF838183FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF000000FF838183FF808080FF0000FFFF0000 + FFFF0000FFFF0000FFFF0000FFFF808080FF838183FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF000000FF838183FFC5C2C5FF808080FFC5C2 + C5FF0000FFFFC5C2C5FF808080FFC5C2C5FF838183FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF7B7D7BFF838183FF808080FFC5C2C5FF8080 + 80FF0000FFFF808080FFC5C2C5FF808080FF838183FF837D83FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF838183FF808080FFC5C2 + C5FF808080FFC5C2C5FF808080FF838183FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF000000FF838183FF837D + 83FF838183FF7B7D7BFF838183FF000000FF000000FF00FFFFFF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF838183FF0000 + 00FF000000FF000000FF838183FF808080FF00FFFFFF838183FF000000FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF000000FF000000FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF000000FF0000 + 00FF000000FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF0000 + 00FF000000FF000000FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FF000000FF000000FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF808080FF808080FF808080FF808080FF838183FF0000 + 00FF000000FF000000FF838183FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF000000FF838183FF837D + 83FF838183FF7B7D7BFF838183FF000000FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF838183FFC5C2C5FF8080 + 80FFC5C2C5FF808080FFC5C2C5FF838183FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF7B7D7BFF838183FFC5BEC5FF808080FFBDBE + BDFF808080FFC5BEC5FF808080FFBDBEBDFF838183FF837D83FF808080FF8080 + 80FF808080FF808080FF808080FF000000FF838183FF808080FFC5C2C5FF8080 + 80FFC5C2C5FF808080FFC5C2C5FF808080FF838183FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF000000FF838183FFBDBEBDFF0000FFFF0000 + FFFF0000FFFF0000FFFF0000FFFFC5BEC5FF838183FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF000000FF838183FF808080FFC5C2C5FF8080 + 80FFC5C2C5FF808080FFC5C2C5FF808080FF838183FF000000FF808080FF8080 + 80FF808080FF808080FF808080FF7B7D7BFF838183FFC5BEC5FF808080FFBDBE + BDFF808080FFC5BEC5FF808080FFBDBEBDFF838183FF837D83FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF000000FF838183FFC5C2C5FF8080 + 80FFC5C2C5FF808080FFC5C2C5FF838183FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF000000FF838183FF837D + 83FF838183FF7B7D7BFF838183FF000000FF000000FF00FFFFFF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF838183FF0000 + 00FF000000FF000000FF838183FF808080FF00FFFFFF838183FF000000FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF000000FF000000FF0000 + 00FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF000000FF0000 + 00FF000000FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF0000 + 00FF000000FF000000FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FF000000FF000000FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF808080FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FF808080FFFFFF00FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF7B7D + 7BFF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8381 + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF808080FF000000FF808080FF000000FF000000FF808080FF808080FF837D + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF000000FF000000FF808080FF000000FF000000FF808080FF808080FF8381 + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF0000 + 00FF000000FF000000FF808080FF000000FF000000FF808080FF808080FF7B7D + 7BFF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF000000FF000000FF808080FF000000FF000000FF808080FF808080FF8381 + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF808080FF000000FF808080FF000000FF000000FF808080FF808080FF837D + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8381 + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF7B7D + 7BFF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF838183FF8381 + 83FF838183FF838183FF838183FF838183FF838183FF838183FF838183FF8381 + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FFFFFF00FF808080FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FF808080FFFFFF00FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF7B7D + 7BFF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8381 + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF000000FF000000FF808080FF000000FF808080FF808080FF808080FF837D + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF000000FF000000FF808080FF000000FF000000FF808080FF808080FF8381 + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF000000FF000000FF808080FF000000FF000000FF000000FF808080FF7B7D + 7BFF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF000000FF000000FF808080FF000000FF000000FF808080FF808080FF8381 + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF000000FF000000FF808080FF000000FF808080FF808080FF808080FF837D + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8381 + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF7B7D + 7BFF000000FFFFFF00FF808080FFFFFF00FF000000FF808080FF838183FF8381 + 83FF838183FF838183FF838183FF838183FF838183FF838183FF838183FF8381 + 83FF000000FFFFFF00FF808080FFFFFF00FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FFFFFF00FF808080FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF + } + end + object ODImage: TOpenDialog + FilterIndex = 0 + Options = [ofAllowMultiSelect, ofEnableSizing, ofViewDetail] + left = 72 + top = 64 + end + object OpenDialog1: TOpenDialog + FilterIndex = 0 + left = 72 + top = 104 + end +end diff --git a/applications/lazstats/source/not used by LazStats/frmmain.lrs b/applications/lazstats/source/not used by LazStats/frmmain.lrs new file mode 100644 index 000000000..3c683968f --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/frmmain.lrs @@ -0,0 +1,990 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TPicViewFrm','FORMDATA',[ + 'TPF0'#11'TPicViewFrm'#10'PicViewFrm'#4'Left'#2#0#6'Height'#2#0#3'Top'#3#204#2 + +#5'Width'#2#0#18'HorzScrollBar.Page'#3'g'#3#19'HorzScrollBar.Range'#3#165#0 + +#18'VertScrollBar.Page'#3'g'#2#19'VertScrollBar.Range'#2#23#13'ActiveControl' + +#7#7'LBFiles'#7'Caption'#6#12'Image viewer'#12'ClientHeight'#2#0#11'ClientWi' + +'dth'#2#0#11'Font.Height'#2#243#9'Font.Name'#6#13'MS Sans Serif'#4'Menu'#7#9 + +'MainMenu1'#9'OnKeyDown'#7#11'FormKeyDown'#6'OnShow'#7#8'FormShow'#10'LCLVer' + +'sion'#6#8'0.9.28.2'#0#9'TSplitter'#7'SPImage'#4'Left'#3#161#0#6'Height'#2#0 + +#3'Top'#2#23#5'Width'#2#4#7'Beveled'#9#0#0#8'TToolBar'#8'ToolBar1'#4'Left'#2 + +#0#6'Height'#2#29#3'Top'#2#0#5'Width'#3#165#0#12'ButtonHeight'#2#23#7'Captio' + +'n'#6#8'ToolBar1'#6'Images'#7#6'ILMain'#14'ParentShowHint'#8#8'ShowHint'#9#8 + +'TabOrder'#2#0#0#11'TToolButton'#6'TBOPen'#4'Left'#2#1#3'Top'#2#2#6'Action'#7 + +#5'AOpen'#0#0#11'TToolButton'#9'TBOpenDir'#4'Left'#2#24#3'Top'#2#2#6'Action' + +#7#8'AOpenDir'#0#0#11'TToolButton'#12'TBOpenDirRec'#4'Left'#2'/'#3'Top'#2#2#6 + +'Action'#7#18'OpenDirRecursively'#0#0#11'TToolButton'#11'ToolButton4'#4'Left' + +#2'F'#3'Top'#2#2#5'Width'#2#8#7'Caption'#6#11'ToolButton4'#10'ImageIndex'#2#3 + +#5'Style'#7#12'tbsSeparator'#0#0#11'TToolButton'#6'TBPRev'#4'Left'#2'N'#3'To' + +'p'#2#2#6'Action'#7#14'APreviousImage'#0#0#11'TToolButton'#6'TBNext'#4'Left' + +#2'e'#3'Top'#2#2#6'Action'#7#10'ANextImage'#0#0#11'TToolButton'#9'TBPRevDir' + +#4'Left'#2'|'#3'Top'#2#2#6'Action'#7#13'APrevImageDir'#0#0#11'TToolButton'#9 + +'TBNextDir'#4'Left'#2#1#3'Top'#2#25#6'Action'#7#13'ANextImageDir'#0#0#11'TTo' + +'olButton'#12'TBDoubleSize'#4'Left'#2#24#3'Top'#2#25#6'Action'#7#11'ADoubleS' + +'ize'#0#0#11'TToolButton'#10'TBHalfSize'#4'Left'#2'/'#3'Top'#2#25#6'Action'#7 + +#9'AHalfSize'#0#0#11'TToolButton'#11'ToolButton3'#4'Left'#2'F'#3'Top'#2#25#5 + +'Width'#2#8#7'Caption'#6#11'ToolButton3'#10'ImageIndex'#2#10#5'Style'#7#12't' + +'bsSeparator'#0#0#0#8'TListBox'#7'LBFiles'#4'Left'#2#0#6'Height'#2#0#3'Top'#2 + +#23#5'Width'#3#161#0#5'Align'#7#6'alLeft'#16'ClickOnSelChange'#8#10'Font.Col' + +'or'#7#7'clBlack'#11'Font.Height'#2#15#9'Font.Name'#6#5'Arial'#10'Font.Pitch' + +#7#10'fpVariable'#10'ItemHeight'#2#0#7'OnClick'#7#12'LBFilesClick'#9'OnKeyDo' + +'wn'#7#11'FormKeyDown'#10'ParentFont'#8#8'TabOrder'#2#1#0#0#6'TPanel'#6'PIma' + +'ge'#4'Left'#3#165#0#6'Height'#2#0#3'Top'#2#23#5'Width'#2#0#5'Align'#7#8'alC' + +'lient'#12'ClientHeight'#2#0#11'ClientWidth'#2#0#11'FullRepaint'#8#8'TabOrde' + +'r'#2#2#0#10'TScrollBox'#10'ScrollBox1'#4'Left'#2#0#6'Height'#2#0#3'Top'#2#0 + +#5'Width'#2#0#5'Align'#7#8'alClient'#11'BorderStyle'#7#6'bsNone'#12'ClientHe' + +'ight'#2#0#11'ClientWidth'#2#0#8'TabOrder'#2#0#0#6'TImage'#5'IMain'#4'Left'#2 + +#0#6'Height'#2#0#3'Top'#2#0#5'Width'#2#0#5'Align'#7#8'alClient'#11'Transpare' + +'nt'#9#0#0#0#0#9'TMainMenu'#9'MainMenu1'#6'Images'#7#6'ILMain'#4'left'#2' '#3 + +'top'#2' '#0#9'TMenuItem'#5'File1'#7'Caption'#6#5'&File'#0#9'TMenuItem'#6'MI' + +'Open'#6'Action'#7#5'AOpen'#11'Bitmap.Data'#10':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0 + +#0#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0' '#0#0#0#0#0#0#4#0#0'd'#0#0#0 + +'d'#0#0#0#0#0#0#0#0#0#0#0#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255')$)'#255'JHJ'#255'RLR' + +#255'JLJ'#255'RLR'#255'JLJ'#255'RLR'#255'JHJ'#255'JDJ'#255'A@A'#255'949'#255 + +' '#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#24 + +'0J'#255#197#190#197#255#164#165#164#255#172#174#172#255#172#174#172#255#180 + +#178#180#255#172#170#172#255#172#170#172#255#156#153#156#255#148#149#156#255 + +#139#141#139#255'JHJ'#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255' 4R'#255'RUZ'#255#213#210#213#255#189#190#197#255#205#198#205 + +#255#205#198#205#255#205#198#205#255#197#194#197#255#180#178#180#255#164#165 + +#172#255#164#161#164#255'sqs'#255#24#20#24#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#24'0J'#255#24'0J'#255#205#206#205#255#205#206#205#255 + +#213#214#213#255#222#214#222#255#213#210#213#255#213#206#213#255#189#186#189 + +#255#180#178#180#255#164#161#164#255#156#149#156#255'JHJ'#255#128#128#128#255 + +#128#128#128#255#128#128#128#255' 4R'#255'A}'#189#255'RUZ'#255#222#218#222 + +#255#230#222#230#255#230#226#230#255#230#226#230#255#222#214#222#255#197#198 + +#197#255#180#182#189#255#172#174#180#255#164#161#164#255'jij'#255' '#255 + +#128#128#128#255#128#128#128#255#24'0J'#255#131#198#255#255#24'0J'#255#128 + +#128#128#255#222#222#230#255#238#234#238#255#230#230#230#255#230#226#230#255 + +#197#198#205#255#189#190#189#255#172#174#172#255#164#161#164#255#148#149#148 + +#255'JHJ'#255#128#128#128#255#128#128#128#255' 4R'#255#131#194#255#255'R'#137 + +#205#255'JPR'#255#255#250#255#255#255#246#255#255#246#238#246#255#230#230#230 + +#255#222#214#222#255#205#206#205#255#205#198#205#255#189#190#189#255#189#186 + +#189#255#180#182#180#255'101'#255#128#128#128#255#24'0J'#255#156#214#255#255 + ,#139#198#255#255#131#198#255#255'b'#174#255#255'b'#174#255#255'b'#174#255#255 + +'b'#174#255#255'b'#174#255#255'b'#174#255#255'b'#174#255#255#0#0#0#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255' 4R'#255'j'#165 + +#230#255#164#214#255#255#139#198#255#255'j'#170#238#255#24'4R'#255' 4R'#255 + +#24'4R'#255' 4R'#255#24'4R'#255' 4R'#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255' 4R'#255#24'0J' + +#255#24'4R'#255#24'0J'#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#0 + +#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0 + +#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255 + +#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0 + +#0#255#0#0#0#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128 + +#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#7'OnClick'#7#12'AOpenExecute'#0#0#9'TMenuItem'#9'MIOPenDir'#6'Action'#7#8'A' + +'OpenDir'#11'Bitmap.Data'#10':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0#0#0#0'6'#0#0#0'(' + +#0#0#0#16#0#0#0#16#0#0#0#1#0' '#0#0#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0#0#0#0#0#0 + +#0#0#0#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0 + +#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0 + +#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#0#0#0#255#128#128#128#255#0#255#255#255#128#128#128#255#0#255#255 + +#255#128#128#128#255#0#255#255#255#128#128#128#255#0#255#255#255#128#128#128 + +#255#0#255#255#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#0#0#0#255#0#255#255#255#128#128#128#255#0#255#255#255#131#0 + +#0#255#0#255#255#255#131#0#0#255#0#255#255#255#131#0#0#255#0#255#255#255#128 + +#128#128#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#0#0#0#255#128#128#128#255#0#255#255#255#128#128#128#255#0#255 + +#255#255#131#0#0#255#131#0#0#255#131#0#0#255#0#255#255#255#128#128#128#255#0 + +#255#255#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#0#0#0#255#0#255#255#255#128#128#128#255#0#255#255#255#131#0#0 + +#255#131#0#0#255#0#255#255#255#131#0#0#255#131#0#0#255#0#255#255#255#128#128 + +#128#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#0#0#0#255#128#128#128#255#0#255#255#255#128#128#128#255#0#255#255 + +#255#131#0#0#255#131#0#0#255#131#0#0#255#0#255#255#255#128#128#128#255#0#255 + +#255#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#0#0#0#255#0#255#255#255#128#128#128#255#0#255#255#255#131#0#0#255#0 + +#255#255#255#131#0#0#255#0#255#255#255#131#0#0#255#0#255#255#255#128#128#128 + +#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#0#0#0#255#128#128#128#255#0#255#255#255#128#128#128#255#0#255#255#255 + +#128#128#128#255#0#255#255#255#128#128#128#255#0#255#255#255#128#128#128#255 + +#0#255#255#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0 + +#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#255 + ,#255#255#128#128#128#255#0#255#255#255#128#128#128#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#7'OnClick'#7#15'AOpenDirExecute'#0#0#9'TMenuItem'#12'MIOpenDirRec'#6 + +'Action'#7#18'OpenDirRecursively'#11'Bitmap.Data'#10':'#4#0#0'6'#4#0#0'BM6'#4 + +#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0' '#0#0#0#0#0#0#4#0#0'd' + +#0#0#0'd'#0#0#0#0#0#0#0#0#0#0#0#128#128#128#255#131#133#131#255#0#8#8#255#128 + +#128#128#255#0#0#0#255#16#16#16#255#0#0#0#255#0#4#8#255#0#0#0#255#0#4#8#255#0 + +#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#139#137#139#255#128#128#128#255#205#190#197#255 + +#222#206#213#255#197#178#180#255#230#210#222#255#205#198#205#255#197#194#197 + +#255#197#198#197#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#148#141#139#255#255#250 + +#255#255#213#198#205#255#222#202#205#255#230#206#213#255#213#190#189#255#213 + +#198#205#255#205#198#197#255#222#210#213#255#8#0#0#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +'{}{'#255#128#128#128#255#205#206#205#255#213#206#213#255#197#186#189#255#222 + +#206#213#255#222#198#205#255#230#206#213#255#213#190#197#255#16#0#0#255#8#0#0 + +#255' '#16#16#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#131#141#139#255#128#128#128#255#197#198#197#255#197#202#205#255#205#202 + +#205#255#205#202#205#255#213#194#197#255#222#202#205#255#213#194#197#255#8#0 + +#0#255#230#218#222#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255'{'#133#131#255#128#128#128#255#197#198#197#255#205#210 + +#213#255#205#206#205#255#205#198#205#255#205#202#205#255#197#194#197#255#197 + +#202#197#255#0#4#0#255#180#190#189#255#0#8#0#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#139#137#139#255#255#250#255#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#255#250#255#255#128 + +#128#128#255#255#250#255#255#0#0#0#255#197#206#205#255#0#0#0#255#0#4#0#255#0 + +#0#0#255#128#128#128#255#128#128#128#255#156#129#131#255#24#0#139#255#16#0 + +#139#255#24#0#213#255#16#0#205#255#24#0#255#255#16#0#255#255#24#0#255#255#16 + +#0#255#255' '#8#8#255#213#198#205#255#8#0#0#255#205#202#205#255#0#4#0#255#128 + +#128#128#255#128#128#128#255#156#129#131#255#148#137#131#255#156#137#139#255 + +#148#137#131#255#156#137#139#255#148#137#131#255#156#137#139#255#148#137#131 + +#255#156#137#139#255' '#0#0#255#246#206#213#255#16#0#0#255#213#202#205#255#0 + +#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#172 + +'}'#131#255#255#250#255#255#255#242#255#255#255#250#255#255#255#246#255#255 + +#255#250#255#255#255#250#255#255#128#128#128#255#255#242#246#255' '#0#0#255 + +#222#194#197#255#16#0#8#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#172#141#148#255#16#0#139#255#24#0#139#255#16#0#205#255#16#0 + +#213#255#16#0#255#255#24#0#255#255#16#0#255#255#16#0#255#255#24#0#0#255#213 + +#194#197#255#8#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#131'y{'#255#148#129#131#255#156#133#139#255#156#133#139#255#148 + +#137#131#255#156#137#139#255#148#133#131#255#148#137#139#255#131'}{'#255#8#4 + +#0#255#222#214#213#255#0#4#0#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#148#137#139#255#255#250 + +#255#255#128#128#128#255#128#128#128#255#255#250#246#255#128#128#128#255#128 + +#128#128#255#255#250#246#255#128#128#128#255#0#0#0#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#156#137#139#255#24#0#139#255#16#0#139#255#24#0#213#255#16#0#205#255#24#0#255 + +#255#16#0#255#255#24#0#255#255#16#0#255#255#24#0#0#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#148'}'#131#255#156#129#131#255#156#137#139#255#148#137#131#255#156#137#139 + +#255#148#137#131#255#156#137#139#255#148#137#131#255#156#137#139#255#16#0#0 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + ,#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#7'OnClick'#7#25'OpenDirRecu' + +'rsivelyExecute'#0#0#9'TMenuItem'#7'MIClear'#6'Action'#7#6'AClear'#7'OnClick' + +#7#13'AClearExecute'#0#0#9'TMenuItem'#2'N1'#7'Caption'#6#1'-'#0#0#9'TMenuIte' + +'m'#6'MIQuit'#6'Action'#7#5'AExit'#7'OnClick'#7#12'AExitExecute'#0#0#0#9'TMe' + +'nuItem'#6'MImage'#7'Caption'#6#6'&Image'#0#9'TMenuItem'#2'D1'#6'Action'#7#11 + +'ADoubleSize'#11'Bitmap.Data'#10':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0#0#0#0'6'#0#0 + +#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0' '#0#0#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0#0#0 + +#0#0#0#0#0#0#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#131#129#131#255#0#0 + +#0#255#0#0#0#255#0#0#0#255#131#129#131#255#128#128#128#255#0#255#255#255#131 + +#129#131#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#131#129#131#255#131'}' + +#131#255#131#129#131#255'{}{'#255#131#129#131#255#0#0#0#255#0#0#0#255#0#255 + +#255#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#0#0#0#255#131#129#131#255#128#128#128#255#197 + +#194#197#255#128#128#128#255#197#194#197#255#128#128#128#255#131#129#131#255 + +#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255'{}{'#255#131#129#131#255#128#128#128#255#197 + +#194#197#255#128#128#128#255#0#0#255#255#128#128#128#255#197#194#197#255#128 + +#128#128#255#131#129#131#255#131'}'#131#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#131#129#131#255 + +#197#194#197#255#128#128#128#255#197#194#197#255#0#0#255#255#197#194#197#255 + +#128#128#128#255#197#194#197#255#131#129#131#255#0#0#0#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255 + +#131#129#131#255#128#128#128#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255 + +#255#0#0#255#255#128#128#128#255#131#129#131#255#0#0#0#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255 + +#131#129#131#255#197#194#197#255#128#128#128#255#197#194#197#255#0#0#255#255 + +#197#194#197#255#128#128#128#255#197#194#197#255#131#129#131#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255'{}{'#255#131#129#131#255#128#128#128#255#197#194#197#255#128#128#128#255 + +#0#0#255#255#128#128#128#255#197#194#197#255#128#128#128#255#131#129#131#255 + +#131'}'#131#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#0#0#0#255#131#129#131#255#128#128#128 + +#255#197#194#197#255#128#128#128#255#197#194#197#255#128#128#128#255#131#129 + +#131#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0 + +#0#255#131#129#131#255#131'}'#131#255#131#129#131#255'{}{'#255#131#129#131 + +#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#131#129#131#255#0#0#0#255#0#0#0#255#0#0#0#255#131 + +#129#131#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#7'OnClick'#7 + +#18'ADoubleSizeExecute'#0#0#9'TMenuItem'#10'MIHalfSize'#6'Action'#7#9'AHalfS' + +'ize'#11'Bitmap.Data'#10':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0#0#0#0'6'#0#0#0'('#0#0 + +#0#16#0#0#0#16#0#0#0#1#0' '#0#0#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0#0#0#0#0#0#0#0 + +#0#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + ,#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0 + +#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#131#129#131#255#0#0#0#255#0 + +#0#0#255#0#0#0#255#131#129#131#255#128#128#128#255#0#255#255#255#131#129#131 + +#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#0#0#0#255#131#129#131#255#131'}'#131#255 + +#131#129#131#255'{}{'#255#131#129#131#255#0#0#0#255#0#0#0#255#0#255#255#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#0#0#0#255#131#129#131#255#197#194#197#255#128#128#128 + +#255#197#194#197#255#128#128#128#255#197#194#197#255#131#129#131#255#0#0#0 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255'{}{'#255#131#129#131#255#197#190#197#255#128#128#128 + +#255#189#190#189#255#128#128#128#255#197#190#197#255#128#128#128#255#189#190 + +#189#255#131#129#131#255#131'}'#131#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#131#129#131#255#128 + +#128#128#255#197#194#197#255#128#128#128#255#197#194#197#255#128#128#128#255 + +#197#194#197#255#128#128#128#255#131#129#131#255#0#0#0#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255 + +#131#129#131#255#189#190#189#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255 + +#255#0#0#255#255#197#190#197#255#131#129#131#255#0#0#0#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255 + +#131#129#131#255#128#128#128#255#197#194#197#255#128#128#128#255#197#194#197 + +#255#128#128#128#255#197#194#197#255#128#128#128#255#131#129#131#255#0#0#0 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255'{}{'#255#131#129#131#255#197#190#197#255#128#128#128#255#189#190#189 + +#255#128#128#128#255#197#190#197#255#128#128#128#255#189#190#189#255#131#129 + +#131#255#131'}'#131#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#131#129#131#255#197 + +#194#197#255#128#128#128#255#197#194#197#255#128#128#128#255#197#194#197#255 + +#131#129#131#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#0#0#0#255#131#129#131#255#131'}'#131#255#131#129#131#255'{}{'#255#131 + +#129#131#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#131#129#131#255#0#0#0#255#0#0#0#255#0#0#0 + +#255#131#129#131#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#7'O' + +'nClick'#7#16'AHalfSizeExecute'#0#0#9'TMenuItem'#2'N2'#7'Caption'#6#1'-'#0#0 + +#9'TMenuItem'#11'MINextImage'#6'Action'#7#10'ANextImage'#11'Bitmap.Data'#10 + +':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0 + +' '#0#0#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0#0#0#0#0#0#0#0#0#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + ,#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#255#255#0 + +#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0 + +#255#255#0#0#255#255#0#0#255#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0 + +#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0 + +#255#255#0#0#255#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#0#0 + +#0#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255 + +#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255 + +#0#0#255#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0 + +#0#255#0#0#0#255#0#0#0#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0 + +#0#255#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#0#0#0#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#0#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#0#0#0#255#0#0#255#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#8'ShortCut'#4#18#144#0#0#7'OnClick'#7#17'ANextImageExec' + +'ute'#0#0#9'TMenuItem'#14'PreviousImage1'#6'Action'#7#14'APreviousImage'#11 + +'Bitmap.Data'#10':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#16#0 + +#0#0#16#0#0#0#1#0' '#0#0#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0#0#0#0#0#0#0#0#0#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#255#255#0#0 + +#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#0#0#0#255#0#0#0#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0 + +#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0 + +#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#0#255#0 + +#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0 + ,#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255 + +#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0 + +#255#255#0#0#0#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0 + +#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#0#255#0#0#0#255 + +#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#255#255#0#0 + +#255#255#0#0#255#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0 + +#0#255#0#0#0#255#0#0#255#255#0#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#8'ShortCut'#4#20#144#0#0#7'OnClick'#7#21 + +'APreviousImageExecute'#0#0#9'TMenuItem'#19'Nextimagedirectory1'#6'Action'#7 + +#13'ANextImageDir'#11'Bitmap.Data'#10':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0#0#0#0'6' + +#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0' '#0#0#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0 + +#0#0#0#0#0#0#0#0#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#0#0#0 + +#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0 + +#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255 + +#0#255#0#0#0#255#128#128#128#255#131#129#131#255#131#129#131#255#131#129#131 + +#255#131#129#131#255#131#129#131#255#131#129#131#255#131#129#131#255#131#129 + +#131#255#131#129#131#255#131#129#131#255#0#0#0#255#255#255#0#255#128#128#128 + +#255#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255'{}{'#255#0#0#0#255#255#255#0#255#128#128 + +#128#255#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#131#129#131#255#0#0#0#255#255#255#0 + +#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#131'}'#131#255#0#0#0#255#255#255#0#255 + +#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128 + +#128#255#128#128#128#255#131#129#131#255#0#0#0#255#255#255#0#255#128#128#128 + +#255#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#0#0#0#255#0#0#0#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128 + +#128#255'{}{'#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#128 + +#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#131#129#131 + +#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255 + +#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#131'}'#131#255#0#0 + +#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255 + ,#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#131#129 + +#131#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255'{}{'#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0 + +#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0 + +#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#255#255#0#255#128 + +#128#128#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#128 + +#128#128#255#7'OnClick'#7#20'ANextImageDirExecute'#0#0#9'TMenuItem'#23'Previ' + +'ousimagedirectory1'#6'Action'#7#13'APrevImageDir'#11'Bitmap.Data'#10':'#4#0 + +#0'6'#4#0#0'BM6'#4#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0' '#0#0 + +#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0#0#0#0#0#0#0#0#0#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#128#128#128#255 + +#255#255#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0 + +#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#255#255 + +#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255#131#129#131 + +#255#131#129#131#255#131#129#131#255#131#129#131#255#131#129#131#255#131#129 + +#131#255#131#129#131#255#131#129#131#255#131#129#131#255#131#129#131#255#0#0 + +#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255'{}{'#255 + +#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#131 + +#129#131#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255 + +#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#131'}' + +#131#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128 + +#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#131#129#131#255#0#0 + +#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255 + +#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#0#0#0#255#0#0 + +#0#255#128#128#128#255#128#128#128#255'{}{'#255#0#0#0#255#255#255#0#255#128 + +#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#0#0#0#255#0#0#0#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#131#129#131#255#0#0#0#255#255#255#0#255#128#128#128#255 + +#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#0#0#0#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255 + +#128#128#128#255#131'}'#131#255#0#0#0#255#255#255#0#255#128#128#128#255#255 + +#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#131#129#131#255#0#0#0#255#255#255#0#255#128#128 + +#128#255#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255'{}{'#255#0#0#0#255#255#255#0#255#128 + +#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#255 + +#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0 + +#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0 + +#0#0#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + ,#255#255#255#0#255#255#255#0#255#128#128#128#255#7'OnClick'#7#20'APrevImageD' + +'irExecute'#0#0#0#0#11'TActionList'#11'ActionList1'#6'Images'#7#6'ILMain'#4 + +'left'#2'H'#3'top'#2' '#0#7'TAction'#5'AOpen'#7'Caption'#6#5'&Open'#8'HelpTy' + +'pe'#7#9'htKeyword'#10'ImageIndex'#2#0#9'OnExecute'#7#12'AOpenExecute'#8'Sho' + +'rtCut'#3'O@'#0#0#7'TAction'#8'AOpenDir'#7'Caption'#6#15'Open &Directory'#8 + +'HelpType'#7#9'htKeyword'#10'ImageIndex'#2#1#9'OnExecute'#7#15'AOpenDirExecu' + +'te'#8'ShortCut'#3'D@'#0#0#7'TAction'#5'AExit'#7'Caption'#6#5'&Quit'#8'HelpT' + +'ype'#7#9'htKeyword'#9'OnExecute'#7#12'AExitExecute'#8'ShortCut'#3'Q@'#0#0#7 + +'TAction'#6'AClear'#7'Caption'#6#11'&Clear list'#8'HelpType'#7#9'htKeyword'#9 + +'OnExecute'#7#13'AClearExecute'#8'ShortCut'#3'L@'#0#0#7'TAction'#18'OpenDirR' + +'ecursively'#7'Caption'#6#27'Open Directory &Recursively'#8'HelpType'#7#9'ht' + +'Keyword'#10'ImageIndex'#2#2#9'OnExecute'#7#25'OpenDirRecursivelyExecute'#8 + +'ShortCut'#3'R@'#0#0#7'TAction'#11'ADoubleSize'#7'Caption'#6#12'&Double size' + +#8'HelpType'#7#9'htKeyword'#10'ImageIndex'#2#5#9'OnExecute'#7#18'ADoubleSize' + +'Execute'#8'ShortCut'#3'+@'#0#0#7'TAction'#9'AHalfSize'#7'Caption'#6#11'&Hal' + +'f Size'#8'HelpType'#7#9'htKeyword'#10'ImageIndex'#2#6#9'OnExecute'#7#16'AH' + +'alfSizeExecute'#8'ShortCut'#3'-@'#0#0#7'TAction'#10'ANextImage'#7'Caption'#6 + +#11'&Next image'#8'HelpType'#7#9'htKeyword'#10'ImageIndex'#2#4#9'OnExecute'#7 + +#17'ANextImageExecute'#0#0#7'TAction'#14'APreviousImage'#7'Caption'#6#15'&Pr' + +'evious Image'#8'HelpType'#7#9'htKeyword'#10'ImageIndex'#2#3#9'OnExecute'#7 + +#21'APreviousImageExecute'#0#0#7'TAction'#13'ANextImageDir'#7'Caption'#6#21 + +'N&ext image directory'#8'HelpType'#7#9'htKeyword'#10'ImageIndex'#2#8#9'OnEx' + +'ecute'#7#20'ANextImageDirExecute'#8'ShortCut'#4'N'#128#0#0#0#0#7'TAction'#13 + +'APrevImageDir'#7'Caption'#6#25'Pre&vious image directory'#8'HelpType'#7#9'h' + +'tKeyword'#4'Hint'#6'(Jump to last image of previous directory'#10'ImageInde' + +'x'#2#7#9'OnExecute'#7#20'APrevImageDirExecute'#8'ShortCut'#4'P'#128#0#0#0#0 + +#0#10'TImageList'#6'ILMain'#4'left'#2' '#3'top'#2'@'#6'Bitmap'#10#14'$'#0#0 + +'Li'#9#0#0#0#16#0#0#0#16#0#0#0#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0 + +#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128 + +#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255' 4R'#255 + +#24'0J'#255#24'4R'#255#24'0J'#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255' 4R'#255'j'#165#230 + +#255#164#214#255#255#139#198#255#255'j'#170#238#255#24'4R'#255' 4R'#255#24'4' + +'R'#255' 4R'#255#24'4R'#255' 4R'#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#24'0J'#255#156#214#255#255#139#198 + +#255#255#131#198#255#255'b'#174#255#255'b'#174#255#255'b'#174#255#255'b'#174 + +#255#255'b'#174#255#255'b'#174#255#255'b'#174#255#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255' 4R'#255#131#194#255#255 + +'R'#137#205#255'JPR'#255#255#250#255#255#255#246#255#255#246#238#246#255#230 + +#230#230#255#222#214#222#255#205#206#205#255#205#198#205#255#189#190#189#255 + +#189#186#189#255#180#182#180#255'101'#255#128#128#128#255#24'0J'#255#131#198 + +#255#255#24'0J'#255#128#128#128#255#222#222#230#255#238#234#238#255#230#230 + +#230#255#230#226#230#255#197#198#205#255#189#190#189#255#172#174#172#255#164 + +#161#164#255#148#149#148#255'JHJ'#255#128#128#128#255#128#128#128#255' 4R' + +#255'A}'#189#255'RUZ'#255#222#218#222#255#230#222#230#255#230#226#230#255#230 + +#226#230#255#222#214#222#255#197#198#197#255#180#182#189#255#172#174#180#255 + +#164#161#164#255'jij'#255' '#255#128#128#128#255#128#128#128#255#24'0J'#255 + +#24'0J'#255#205#206#205#255#205#206#205#255#213#214#213#255#222#214#222#255 + +#213#210#213#255#213#206#213#255#189#186#189#255#180#178#180#255#164#161#164 + +#255#156#149#156#255'JHJ'#255#128#128#128#255#128#128#128#255#128#128#128#255 + ,' 4R'#255'RUZ'#255#213#210#213#255#189#190#197#255#205#198#205#255#205#198 + +#205#255#205#198#205#255#197#194#197#255#180#178#180#255#164#165#172#255#164 + +#161#164#255'sqs'#255#24#20#24#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#24'0J'#255#197#190#197#255#164#165#164#255#172#174#172#255#172#174 + +#172#255#180#178#180#255#172#170#172#255#172#170#172#255#156#153#156#255#148 + +#149#156#255#139#141#139#255'JHJ'#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255')$)'#255'JHJ'#255'RLR'#255'JLJ'#255'RLR'#255'JLJ' + +#255'RLR'#255'JHJ'#255'JDJ'#255'A@A'#255'949'#255' '#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#0 + +#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#0#0#0#255#0#255#255#255#128#128#128#255#0 + +#255#255#255#128#128#128#255#0#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0 + +#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255 + +#128#128#128#255#0#255#255#255#128#128#128#255#0#255#255#255#128#128#128#255 + +#0#255#255#255#128#128#128#255#0#255#255#255#128#128#128#255#0#255#255#255#0 + +#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0 + +#0#255#0#255#255#255#128#128#128#255#0#255#255#255#131#0#0#255#0#255#255#255 + +#131#0#0#255#0#255#255#255#131#0#0#255#0#255#255#255#128#128#128#255#0#0#0 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0 + +#255#128#128#128#255#0#255#255#255#128#128#128#255#0#255#255#255#131#0#0#255 + +#131#0#0#255#131#0#0#255#0#255#255#255#128#128#128#255#0#255#255#255#0#0#0 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0 + +#255#0#255#255#255#128#128#128#255#0#255#255#255#131#0#0#255#131#0#0#255#0 + +#255#255#255#131#0#0#255#131#0#0#255#0#255#255#255#128#128#128#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255 + +#128#128#128#255#0#255#255#255#128#128#128#255#0#255#255#255#131#0#0#255#131 + +#0#0#255#131#0#0#255#0#255#255#255#128#128#128#255#0#255#255#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0 + +#255#255#255#128#128#128#255#0#255#255#255#131#0#0#255#0#255#255#255#131#0#0 + +#255#0#255#255#255#131#0#0#255#0#255#255#255#128#128#128#255#0#0#0#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#128 + +#128#128#255#0#255#255#255#128#128#128#255#0#255#255#255#128#128#128#255#0 + +#255#255#255#128#128#128#255#0#255#255#255#128#128#128#255#0#255#255#255#0#0 + +#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0 + +#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0 + +#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + ,#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#148'}'#131#255#156#129#131#255#156#137 + +#139#255#148#137#131#255#156#137#139#255#148#137#131#255#156#137#139#255#148 + +#137#131#255#156#137#139#255#16#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#156#137#139#255 + +#24#0#139#255#16#0#139#255#24#0#213#255#16#0#205#255#24#0#255#255#16#0#255 + +#255#24#0#255#255#16#0#255#255#24#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#148#137#139#255 + +#255#250#255#255#128#128#128#255#128#128#128#255#255#250#246#255#128#128#128 + +#255#128#128#128#255#255#250#246#255#128#128#128#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#131'y{'#255#148#129#131 + +#255#156#133#139#255#156#133#139#255#148#137#131#255#156#137#139#255#148#133 + +#131#255#148#137#139#255#131'}{'#255#8#4#0#255#222#214#213#255#0#4#0#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#172#141#148#255 + +#16#0#139#255#24#0#139#255#16#0#205#255#16#0#213#255#16#0#255#255#24#0#255 + +#255#16#0#255#255#16#0#255#255#24#0#0#255#213#194#197#255#8#0#0#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#172'}'#131#255#255 + +#250#255#255#255#242#255#255#255#250#255#255#255#246#255#255#255#250#255#255 + +#255#250#255#255#128#128#128#255#255#242#246#255' '#0#0#255#222#194#197#255 + +#16#0#8#255#128#128#128#255#128#128#128#255#156#129#131#255#148#137#131#255 + +#156#137#139#255#148#137#131#255#156#137#139#255#148#137#131#255#156#137#139 + +#255#148#137#131#255#156#137#139#255' '#0#0#255#246#206#213#255#16#0#0#255 + +#213#202#205#255#0#0#0#255#128#128#128#255#128#128#128#255#156#129#131#255#24 + +#0#139#255#16#0#139#255#24#0#213#255#16#0#205#255#24#0#255#255#16#0#255#255 + +#24#0#255#255#16#0#255#255' '#8#8#255#213#198#205#255#8#0#0#255#205#202#205 + +#255#0#4#0#255#128#128#128#255#128#128#128#255#139#137#139#255#255#250#255 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#255#250 + +#255#255#128#128#128#255#255#250#255#255#0#0#0#255#197#206#205#255#0#0#0#255 + +#0#4#0#255#0#0#0#255#128#128#128#255#128#128#128#255'{'#133#131#255#128#128 + +#128#255#197#198#197#255#205#210#213#255#205#206#205#255#205#198#205#255#205 + +#202#205#255#197#194#197#255#197#202#197#255#0#4#0#255#180#190#189#255#0#8#0 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#131#141 + +#139#255#128#128#128#255#197#198#197#255#197#202#205#255#205#202#205#255#205 + +#202#205#255#213#194#197#255#222#202#205#255#213#194#197#255#8#0#0#255#230 + +#218#222#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255'{}{'#255#128#128#128#255#205#206#205#255#213#206#213#255#197#186 + +#189#255#222#206#213#255#222#198#205#255#230#206#213#255#213#190#197#255#16#0 + +#0#255#8#0#0#255' '#16#16#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#148#141#139#255#255#250#255#255#213#198#205#255#222#202#205 + +#255#230#206#213#255#213#190#189#255#213#198#205#255#205#198#197#255#222#210 + +#213#255#8#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#139#137#139#255#128#128#128#255#205 + +#190#197#255#222#206#213#255#197#178#180#255#230#210#222#255#205#198#205#255 + +#197#194#197#255#197#198#197#255#0#0#0#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#131#133#131 + +#255#0#8#8#255#128#128#128#255#0#0#0#255#16#16#16#255#0#0#0#255#0#4#8#255#0#0 + +#0#255#0#4#8#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + ,#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#255#255#0#0#0#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#0#0#0#255#0#0#0#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#0#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#255 + +#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#0#255#0#0#0#255#0#0 + +#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#255 + +#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255 + +#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0 + +#0#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#255#255#0#0 + +#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#0#255#0#0#0#255#0#0#0#255#0 + +#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#255#255#0#0#255#255#0#0 + +#255#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0 + +#255#0#0#255#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#255#255#0#0#0#255#0#0 + +#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#255#255#0#0 + +#255#255#0#0#255#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0 + +#255#0#0#0#255#0#0#0#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0 + +#255#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0 + +#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255 + +#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255 + +#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0 + +#255#0#0#0#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0 + +#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0 + +#0#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#0#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0 + ,#0#255#0#0#255#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#131#129#131#255#0#0#0#255#0#0#0#255#0#0#0#255#131#129#131#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#0#0#0#255#131#129#131#255#131'}'#131#255#131#129#131#255'{}{'#255#131 + +#129#131#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#0#0#0#255#131#129#131#255#128#128#128#255#197#194#197#255#128#128#128#255 + +#197#194#197#255#128#128#128#255#131#129#131#255#0#0#0#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255'{}{'#255#131#129#131#255#128#128#128#255#197#194#197#255#128#128#128#255 + +#0#0#255#255#128#128#128#255#197#194#197#255#128#128#128#255#131#129#131#255 + +#131'}'#131#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#0#0#0#255#131#129#131#255#197#194#197#255#128#128#128 + +#255#197#194#197#255#0#0#255#255#197#194#197#255#128#128#128#255#197#194#197 + +#255#131#129#131#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#0#0#0#255#131#129#131#255#128#128#128 + +#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#128#128#128 + +#255#131#129#131#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#0#0#0#255#131#129#131#255#197#194#197 + +#255#128#128#128#255#197#194#197#255#0#0#255#255#197#194#197#255#128#128#128 + +#255#197#194#197#255#131#129#131#255#0#0#0#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255'{}{'#255#131#129#131#255 + +#128#128#128#255#197#194#197#255#128#128#128#255#0#0#255#255#128#128#128#255 + +#197#194#197#255#128#128#128#255#131#129#131#255#131'}'#131#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#0#0#0#255#131#129#131#255#128#128#128#255#197#194#197#255#128#128 + +#128#255#197#194#197#255#128#128#128#255#131#129#131#255#0#0#0#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#131#129#131#255#131'}' + +#131#255#131#129#131#255'{}{'#255#131#129#131#255#0#0#0#255#0#0#0#255#0#255 + +#255#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#131#129#131#255 + +#0#0#0#255#0#0#0#255#0#0#0#255#131#129#131#255#128#128#128#255#0#255#255#255 + +#131#129#131#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0 + +#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + ,#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#131#129#131#255 + +#0#0#0#255#0#0#0#255#0#0#0#255#131#129#131#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#131#129 + +#131#255#131'}'#131#255#131#129#131#255'{}{'#255#131#129#131#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#131#129#131 + +#255#197#194#197#255#128#128#128#255#197#194#197#255#128#128#128#255#197#194 + +#197#255#131#129#131#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255'{}{'#255#131#129#131 + +#255#197#190#197#255#128#128#128#255#189#190#189#255#128#128#128#255#197#190 + +#197#255#128#128#128#255#189#190#189#255#131#129#131#255#131'}'#131#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#0#0#0#255#131#129#131#255#128#128#128#255#197#194#197#255#128#128#128#255 + +#197#194#197#255#128#128#128#255#197#194#197#255#128#128#128#255#131#129#131 + +#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#0#0#0#255#131#129#131#255#189#190#189#255#0#0#255#255#0 + +#0#255#255#0#0#255#255#0#0#255#255#0#0#255#255#197#190#197#255#131#129#131 + +#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#0#0#0#255#131#129#131#255#128#128#128#255#197#194#197 + +#255#128#128#128#255#197#194#197#255#128#128#128#255#197#194#197#255#128#128 + +#128#255#131#129#131#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255'{}{'#255#131#129#131#255#197#190#197 + +#255#128#128#128#255#189#190#189#255#128#128#128#255#197#190#197#255#128#128 + +#128#255#189#190#189#255#131#129#131#255#131'}'#131#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#0#0#0#255#131#129#131#255#197#194#197#255#128#128#128#255#197#194#197#255 + +#128#128#128#255#197#194#197#255#131#129#131#255#0#0#0#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#0#0#0#255#131#129#131#255#131'}'#131#255 + +#131#129#131#255'{}{'#255#131#129#131#255#0#0#0#255#0#0#0#255#0#255#255#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#131#129#131#255#0#0#0 + +#255#0#0#0#255#0#0#0#255#131#129#131#255#128#128#128#255#0#255#255#255#131 + +#129#131#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#128#128 + +#128#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#128 + +#128#128#255#255#255#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255 + +#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0 + +#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + ,#128#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255'{}{'#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#131#129#131#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0 + +#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#0#0#0#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128 + +#128#255#131'}'#131#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255 + +#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0 + +#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255#131 + +#129#131#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128 + +#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128#128#255'{}{'#255#0#0#0#255 + +#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#0#0#0#255#0 + +#0#0#255#128#128#128#255#128#128#128#255#131#129#131#255#0#0#0#255#255#255#0 + +#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#0#0#0#255#128#128#128#255#0#0#0#255#0#0#0 + +#255#128#128#128#255#128#128#128#255#131'}'#131#255#0#0#0#255#255#255#0#255 + +#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#131#129#131#255#0#0#0#255 + +#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255'{}{'#255#0#0 + +#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255 + +#131#129#131#255#131#129#131#255#131#129#131#255#131#129#131#255#131#129#131 + +#255#131#129#131#255#131#129#131#255#131#129#131#255#131#129#131#255#131#129 + +#131#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#0#0 + +#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255 + +#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#255#255#0#255#128#128#128#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0 + +#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0 + +#0#0#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0 + +#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255'{}{'#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0 + +#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#131#129#131#255#0#0#0#255#255#255#0#255#128#128#128 + +#255#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#0#0#0#255#0#0#0#255#128#128#128#255#0#0#0#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#131'}'#131#255#0#0#0#255#255#255#0#255#128#128#128#255 + +#255#255#0#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0 + +#0#255#0#0#0#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#128#128 + +#128#255#131#129#131#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0 + +#255#0#0#0#255#128#128#128#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0 + +#0#255#128#128#128#255#0#0#0#255#0#0#0#255#0#0#0#255#128#128#128#255'{}{'#255 + +#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#0#0 + ,#0#255#0#0#0#255#128#128#128#255#128#128#128#255#131#129#131#255#0#0#0#255 + +#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#0#0#0#255#0#0#0#255#128#128#128#255#0#0#0#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#131'}'#131#255#0#0#0#255#255 + +#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#131#129#131#255 + +#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255'{}{' + +#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0#255#128#128 + +#128#255#131#129#131#255#131#129#131#255#131#129#131#255#131#129#131#255#131 + +#129#131#255#131#129#131#255#131#129#131#255#131#129#131#255#131#129#131#255 + +#131#129#131#255#0#0#0#255#255#255#0#255#128#128#128#255#255#255#0#255#0#0#0 + +#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0 + +#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#0#0#0#255#255#255#0#255#128#128#128 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#128#128 + +#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128 + +#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255 + +#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128#255#128#128#128 + +#255#128#128#128#255#128#128#128#255#0#0#11'TOpenDialog'#7'ODImage'#11'Filte' + +'rIndex'#2#0#7'Options'#11#18'ofAllowMultiSelect'#14'ofEnableSizing'#12'ofVi' + +'ewDetail'#0#4'left'#2'H'#3'top'#2'@'#0#0#11'TOpenDialog'#11'OpenDialog1'#11 + +'FilterIndex'#2#0#4'left'#2'H'#3'top'#2'h'#0#0#0 +]); diff --git a/applications/lazstats/source/not used by LazStats/frmmain.pas b/applications/lazstats/source/not used by LazStats/frmmain.pas new file mode 100644 index 000000000..656be0272 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/frmmain.pas @@ -0,0 +1,500 @@ +{ + *************************************************************************** + * * + * This source 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 2 of the License, or * + * (at your option) any later version. * + * * + * This code 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. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** +} +unit frmmain; + +{$MODE Delphi} + +interface + +uses + LCLIntf,SysUtils, Classes, Graphics, Controls, Forms, FileUtil, + Dialogs, StdCtrls, ComCtrls, ExtCtrls, ActnList, Menus, + LResources, LCLType; + +type + TPicViewFrm = class(TForm) + MainMenu1: TMainMenu; + ToolBar1: TToolBar; + ActionList1: TActionList; + AOpen: TAction; + AOpenDir: TAction; + AExit: TAction; + LBFiles: TListBox; + SPImage: TSplitter; + File1: TMenuItem; + MIOpen: TMenuItem; + MIOPenDir: TMenuItem; + N1: TMenuItem; + MIQuit: TMenuItem; + TBOPen: TToolButton; + TBOpenDir: TToolButton; + ILMain: TImageList; + ODImage: TOpenDialog; + AClear: TAction; + MIOpenDirRec: TMenuItem; + MIClear: TMenuItem; + OpenDirRecursively: TAction; + TBOpenDirRec: TToolButton; + ADoubleSize: TAction; + MImage: TMenuItem; + D1: TMenuItem; + AHalfSize: TAction; + MIHalfSize: TMenuItem; + PImage: TPanel; + ScrollBox1: TScrollBox; + IMain: TImage; + ANextImage: TAction; + APreviousImage: TAction; + ANextImageDir: TAction; + APrevImageDir: TAction; + MINextImage: TMenuItem; + PreviousImage1: TMenuItem; + Nextimagedirectory1: TMenuItem; + Previousimagedirectory1: TMenuItem; + ToolButton4: TToolButton; + TBPRev: TToolButton; + TBNext: TToolButton; + TBPRevDir: TToolButton; + TBNextDir: TToolButton; + TBDoubleSize: TToolButton; + TBHalfSize: TToolButton; + ToolButton3: TToolButton; + N2: TMenuItem; + OpenDialog1: TOpenDialog; + procedure AOpenExecute(Sender: TObject); + procedure LBFilesClick(Sender: TObject); + procedure AOpenDirExecute(Sender: TObject); + procedure AExitExecute(Sender: TObject); + procedure OpenDirRecursivelyExecute(Sender: TObject); + procedure AClearExecute(Sender: TObject); + procedure ADoubleSizeExecute(Sender: TObject); + procedure AHalfSizeExecute(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure FormShow(Sender: TObject); + procedure ANextImageExecute(Sender: TObject); + procedure APreviousImageExecute(Sender: TObject); + procedure ANextImageDirExecute(Sender: TObject); + procedure APrevImageDirExecute(Sender: TObject); + private + FImageScale : Double; + procedure AddFile(FileName: String; ShowFile: Boolean); + procedure ShowFile(Index: Integer); + procedure AddDir(Directory: String; Recurse: Boolean); + procedure RescaleImage(NewScale: Double); + procedure NextImage; + procedure PreviousImage; + procedure NextImageDir; + procedure PreviousImageDir; + Function NextDirIndex(Direction : Integer) : Integer; + procedure ShiftImageIndex(MoveBy: Integer); + procedure ProcessCommandLine; + procedure DoError(Msg: String; Args: array of const); + { Private declarations } + public + { Public declarations } + end; + +var + PicViewFrm: TPicViewFrm; + +implementation + +Const + ImageTypes = '.jpg.jpeg.bmp.xpm.png'; + +resourcestring + SSelectImageDir = 'Select directory to add images from'; + SSelectImageDirRec = 'Select directory to recursively add images from'; + SImageViewer = 'Image viewer'; + SErrNeedArgument = 'Option at position%d (%s) needs an argument'; + +{ [] } +procedure TPicViewFrm.AOpenExecute(Sender: TObject); + +Var + I : Integer; + +begin + With ODImage do + begin + If Execute then + for I:=0 to Files.Count-1 do + AddFile(Files[I],(I=0)) + end; +end; + +procedure TPicViewFrm.AddFile(FileName :String; ShowFile : Boolean); + +Var + Index : Integer; + +begin + ShowFile:=ShowFile or (LBFiles.Items.Count=0); + Index:=LBFiles.Items.Add(FileName); + If ShowFile then + self.ShowFile(Index); +end; + +procedure TPicViewFrm.ShowFile(Index : Integer); + +Var + LoadOK : Boolean; + +begin + If Index=-1 then + begin + IMain.Picture:=Nil; + Caption:=SImageViewer; + end + else + Repeat + Try + LoadOK:=False; + IMain.Align:=AlClient; + Imain.Stretch:=False; + FImageScale:=1.0; + IMain.Picture.LoadFromFile(LBFiles.Items[Index]); + Caption:=SImageViewer+'('+LBFiles.Items[Index]+')'; + LoadOK:=True; + Except + If IndexItemIndex then + LBFiles.Itemindex:=Index; +{ If Not ItemVisible(ItemIndex) then + MakeCurrentVisible;} + end; +end; + +procedure TPicViewFrm.LBFilesClick(Sender: TObject); +begin + ShowFile(LBFiles.ItemIndex); +end; + +procedure TPicViewFrm.AOpenDirExecute(Sender: TObject); + +Var + Dir : String; + +begin + if SelectDirectory(SSelectImageDir,'/',Dir) then + +// if SelectDirectory(SSelectImageDir,'/',Dir,True) then + AddDir(Dir,False); +end; + +procedure TPicViewFrm.AddDir(Directory :String; Recurse : Boolean); + +Var + Info : TSearchRec; + Ext : String; +begin + LBFiles.Items.BeginUpdate; + Try + Directory:=IncludeTrailingBackslash(Directory); + if FindFirstUTF8(Directory+'*.*',0,Info)=0 then + try + Repeat + Ext:=ExtractFileExt(Info.Name); + If Pos(Ext,ImageTypes)<>0 then + AddFile(Directory+Info.Name,False); + until (FindNextUTF8(Info)<>0) + Finally + FindCloseUTF8(Info); + end; + If Recurse then + if FindFirstUTF8(Directory+'*',faDirectory,Info)=0 then + try + Repeat + If (Info.Name<>'.') and (Info.Name<>'') and (info.name<>'..') and + ((Info.Attr and faDirectory)<>0) then + AddDir(Directory+Info.name,True); + until (FindNextUTF8(Info)<>0) + finally + FindCloseUTF8(Info); + end; + Finally + LBFiles.Items.EndUpdate; + end; +end; + +procedure TPicViewFrm.AExitExecute(Sender: TObject); +begin + Close; +end; + +procedure TPicViewFrm.OpenDirRecursivelyExecute(Sender: TObject); + +Var + Dir : String; + +begin + if SelectDirectory(SSelectImageDirRec,'/',Dir) then + AddDir(Dir,True); +end; + +procedure TPicViewFrm.AClearExecute(Sender: TObject); +begin + LBFiles.ItemIndex:=-1; + ShowFile(-1); + LBFiles.Items.Clear; +end; + +procedure TPicViewFrm.ADoubleSizeExecute(Sender: TObject); + +begin + RescaleImage(2.0); +end; + +procedure TPicViewFrm.RescaleImage(NewScale : Double); + +Var + OrgWidth,OrgHeight : Integer; + Rect : TRect; + +begin + OrgWidth:=IMain.Picture.Bitmap.Width; + OrgHeight:=IMain.Picture.Bitmap.Height; + FImageScale:=FImageScale*NewScale; + Rect:=IMain.BoundsRect; + Rect.Right:=Rect.Left+Round(OrgWidth*FImageScale); + Rect.Bottom:=Rect.Top+Round(OrgHeight*FImageScale); + Imain.Align:=AlNone; + IMain.BoundsRect:=Rect; + Imain.Stretch:=True; +end; + +procedure TPicViewFrm.AHalfSizeExecute(Sender: TObject); +begin + RescaleImage(0.5); +end; + +procedure TPicViewFrm.NextImage; + +begin + ShiftImageIndex(1); +end; + +procedure TPicViewFrm.PreviousImage; + +begin + ShiftImageIndex(-1); +end; + +procedure TPicViewFrm.ShiftImageIndex(MoveBy : Integer); + +Var + ImageIndex : Integer; + +begin + ImageIndex:=LBFiles.ItemIndex; + ImageIndex:=ImageIndex+MoveBy; + If ImageIndex<0 then + ImageIndex:=LBFiles.Items.Count-1; + If ImageIndex>=LBFiles.Items.Count then + begin + ImageIndex:=0; + If LBFiles.Items.Count=0 then + ImageIndex:=-1; + end; + ShowFile(ImageIndex); +end; + +procedure TPicViewFrm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if (shift=[ssShift]) or (shift=[ssAlt]) then + begin + if (key=VK_Prior) then + begin + RescaleImage(2.0); + Key:=0; + end + else if (key=VK_Next) then + begin + RescaleImage(0.5); + Key:=0; + end + else if (key=VK_Left) then + begin + PreviousImage; + Key:=0; + end + else if (key=VK_right) then + begin + NextImage; + Key:=0; + end + end + else if (shift=[]) then + begin + if Key=VK_UP then + Previousimage + else if Key=VK_DOWN then + NextImage; + end; +end; +procedure TPicViewFrm.DoError(Msg : String; Args : Array Of const); + +begin + ShowMessage(Format(Msg,Args)); +end; + +procedure TPicViewFrm.ProcessCommandLine; + + Function CheckOption(Index : Integer;Short,Long : String): Boolean; + + var + O : String; + + begin + O:=ParamStrUTF8(Index); + Result:=(O='-'+short) or (copy(O,1,Length(Long)+3)=('--'+long+'=')); + end; + + Function OptionArg(Var Index : Integer) : String; + + Var + P : Integer; + + begin + if (Length(ParamStrUTF8(Index))>1) and (ParamStrUTF8(Index)[2]<>'-') then + begin + If Index2 then + begin + P:=Pos('=',ParamStrUTF8(Index)); + If (P=0) then + DoError(SErrNeedArgument,[Index,ParamStrUTF8(Index)]) + else + begin + Result:=ParamStrUTF8(Index); + Delete(Result,1,P); + end; + end; + end; + +Var + I : Integer; + S : String; + FRecursive : Boolean; + +begin + FRecursive:=False; + I:=0; + While (I-1) then + ShowFile(Index); +end; + +Function TPicViewFrm.NextDirIndex(Direction: Integer) : integer; + +Var + Dir : String; + +begin + Result:=-1; + If LBFiles.Itemindex=-1 then + Exit; + Result:=LBFiles.Itemindex; + Dir:=ExtractFilePath(LBFiles.Items[Result]); + Repeat + Result:=Result+Direction; + Until ((Result=-1) or (Result>=LBFiles.Items.Count)) or (Dir<>ExtractFilePath(LBFiles.Items[Result])); + If Result>=LBFiles.Items.Count then + Result:=-1; +end; + +procedure TPicViewFrm.PreviousImageDir; +Var + Index : Integer; + +begin + Index:=NextDirIndex(-1); + If (Index<>-1) then + ShowFile(Index); +end; + +procedure TPicViewFrm.ANextImageExecute(Sender: TObject); +begin + NextImage; +end; + +procedure TPicViewFrm.APreviousImageExecute(Sender: TObject); +begin + PreviousImage +end; + +procedure TPicViewFrm.ANextImageDirExecute(Sender: TObject); +begin + NextImageDir; +end; + +procedure TPicViewFrm.APrevImageDirExecute(Sender: TObject); +begin + PreviousImageDir; +end; + +initialization + {$i frmmain.lrs} + +end. diff --git a/applications/lazstats/source/not used by LazStats/functionsunit.pas b/applications/lazstats/source/not used by LazStats/functionsunit.pas new file mode 100644 index 000000000..2aebdc491 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/functionsunit.pas @@ -0,0 +1,217 @@ +unit FunctionsUnit; + +{$MODE Delphi} + +interface + +uses SysUtils, ItemBankGlobals; + +function ReadMCItem(item : integer; VAR R3 : MCItemRcd) : boolean; +function ReadTFItem(item : integer; VAR R5 : TFItemRcd) : boolean; +function ReadMAItem(item : integer; VAR R1 : MatchItemsRcd) : boolean; +function ReadCOItem(item : integer; VAR R2 : BlankItemRcd) : boolean; +function ReadESItem(item : integer; VAR R4 : EssayItemRcd) : boolean; +procedure WriteMCItem(item : integer; VAR R3 : MCItemRcd); +procedure WriteTFItem(item : integer; VAR R5 : TFItemRcd); +procedure WriteMAItem(item : integer; VAR R1 : MatchItemsRcd); +procedure WriteCOItem(item : integer; VAR R2 : BlankItemRcd); +procedure WriteESItem(item : integer; VAR R4 : EssayItemRcd); + +implementation + +function ReadMCItem(item : integer; VAR R3 : MCItemRcd) : boolean; +var + found : boolean; + F3 : File of MCItemRcd; + filename : string; + +begin + found := false; + if FileExists(MCFName) { *Converted from FileExists* } then // multiple choice items + begin + filename := MCFName; + AssignFile(F3,filename); + Reset(F3); + Seek(F3,item-1); + Read(F3,R3); + found := true; + end; + CloseFile(F3); + Result := found; +end; +//------------------------------------------------------------------- + +function ReadTFItem(item : integer; VAR R5 : TFItemRcd) : boolean; +var + found : boolean; + F5 : File of TFItemRcd; + filename : string; + +begin + found := false; + if FileExists(TFFName) { *Converted from FileExists* } then // true-false items + begin + filename := TFFName; + AssignFile(F5,filename); + Reset(F5); + Seek(F5,item-1); + Read(F5,R5); + found := true; + end; + CloseFile(F5); + Result := found; +end; +//------------------------------------------------------------------- + +function ReadMAItem(item : integer; VAR R1 : MatchItemsRcd) : boolean; +var + found : boolean; + F1 : File of MatchItemsRcd; + filename : string; + +begin + found := false; + if FileExists(MatchFName) { *Converted from FileExists* } then // matching items + begin + filename := MatchFName; + AssignFile(F1,filename); + Reset(F1); + Seek(F1,item-1); + Read(F1,R1); + found := true; + end; + CloseFile(F1); + Result := found; +end; +//------------------------------------------------------------------- + +function ReadCOItem(item : integer; VAR R2 : BlankItemRcd) : boolean; +var + found : boolean; + F2 : File of BlankItemRcd; + filename : string; + +begin + found := false; + if FileExists(BlankFName) { *Converted from FileExists* } then // completion items + begin + filename := BlankFName; + AssignFile(F2,filename); + Reset(F2); + Seek(F2,item-1); + Read(F2,R2); + found := true; + end; + CloseFile(F2); + Result := found; +end; +//------------------------------------------------------------------- + +function ReadESItem(item : integer; VAR R4 : EssayItemRcd) : boolean; +var + found : boolean; + F4 : File of EssayItemRcd; + filename : string; + +begin + found := false; + if FileExists(EssayFName) { *Converted from FileExists* } then // essay items + begin + filename := EssayFName; + AssignFile(F4,filename); + Reset(F4); + Seek(F4,item-1); + Read(F4,R4); + found := true; + end; + CloseFile(F4); + Result := found; +end; +//------------------------------------------------------------------- + +procedure WriteMCItem(item : integer; VAR R3 : MCItemRcd); +var + F3 : File of MCItemRcd; + filename : string; +begin + if FileExists(MCFName) { *Converted from FileExists* } then // multiple choice items + begin + filename := MCFName; + AssignFile(F3,filename); + Reset(F3); + Seek(F3,item-1); + write(F3,R3); + end; + CloseFile(F3); +end; +//------------------------------------------------------------------- + +procedure WriteTFItem(item : integer; VAR R5 : TFItemRcd); +var + F5 : File of TFItemRcd; + filename : string; +begin + if FileExists(TFFName) { *Converted from FileExists* } then // true-false items + begin + filename := TFFName; + AssignFile(F5,filename); + Reset(F5); + Seek(F5,item-1); + write(F5,R5); + end; + CloseFile(F5); +end; +//------------------------------------------------------------------- + +procedure WriteMAItem(item : integer; VAR R1 : MatchItemsRcd); +var + F1 : File of MatchItemsRcd; + filename : string; +begin + if FileExists(MatchFName) { *Converted from FileExists* } then // matching items + begin + filename := MatchFName; + AssignFile(F1,filename); + Reset(F1); + Seek(F1,item-1); + write(F1,R1); + end; + CloseFile(F1); +end; +//------------------------------------------------------------------- + +procedure WriteCOItem(item : integer; VAR R2 : BlankItemRcd); +var + F2 : File of BlankItemRcd; + filename : string; +begin + if FileExists(BlankFName) { *Converted from FileExists* } then // completion items + begin + filename := BlankFName; + AssignFile(F2,filename); + Reset(F2); + Seek(F2,item-1); + write(F2,R2); + end; + CloseFile(F2); +end; +//------------------------------------------------------------------- + +procedure WriteESItem(item : integer; VAR R4 : EssayItemRcd); +var + F4 : File of EssayItemRcd; + filename : string; +begin + if FileExists(EssayFName) { *Converted from FileExists* } then // essay items + begin + filename := EssayFName; + AssignFile(F4,filename); + Reset(F4); + Seek(F4,item-1); + write(F4,R4); + end; + CloseFile(F4); +end; +//------------------------------------------------------------------- + +end. diff --git a/applications/lazstats/source/not used by LazStats/interruptedunit.lfm b/applications/lazstats/source/not used by LazStats/interruptedunit.lfm new file mode 100644 index 000000000..0837cc267 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/interruptedunit.lfm @@ -0,0 +1,287 @@ +object InterruptedFrm: TInterruptedFrm + Left = 129 + Height = 337 + Top = 129 + Width = 537 + Align = alCustom + AutoSize = True + BorderIcons = [biSystemMenu] + BorderStyle = bsDialog + Caption = 'Interrupted Time Series Analysis' + ClientHeight = 337 + ClientWidth = 537 + OnShow = FormShow + Position = poDefault + LCLVersion = '2.1.0.0' + object Label1: TLabel + Left = 2 + Height = 15 + Top = 0 + Width = 97 + Caption = 'Available Variables' + ParentColor = False + end + object Label2: TLabel + Left = 250 + Height = 15 + Top = 2 + Width = 147 + Caption = 'Pre-Treatment Observations' + ParentColor = False + end + object Label3: TLabel + Left = 250 + Height = 15 + Top = 153 + Width = 153 + Caption = 'Post-Treatment Observations' + ParentColor = False + end + object VarList: TListBox + Left = 0 + Height = 271 + Top = 23 + Width = 188 + ItemHeight = 0 + MultiSelect = True + TabOrder = 0 + end + object PreInBtn: TBitBtn + Left = 194 + Height = 29 + Top = 23 + Width = 35 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = PreInBtnClick + TabOrder = 1 + end + object PreOutBtn: TBitBtn + Left = 194 + Height = 29 + Top = 64 + Width = 35 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = PreOutBtnClick + TabOrder = 2 + end + object PostInBtn: TBitBtn + Left = 194 + Height = 29 + Top = 169 + Width = 35 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE + 6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580 + 3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3 + 71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7 + 74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7 + 74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = PostInBtnClick + TabOrder = 3 + end + object PostOutBtn: TBitBtn + Left = 194 + Height = 29 + Top = 208 + Width = 35 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580 + 3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3 + 71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6 + 89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7 + 74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA + 90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF + FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799 + 4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = PostOutBtnClick + TabOrder = 4 + end + object PreList: TListBox + Left = 239 + Height = 118 + Top = 23 + Width = 155 + ItemHeight = 0 + MultiSelect = True + TabOrder = 5 + end + object PostList: TListBox + Left = 239 + Height = 127 + Top = 169 + Width = 158 + ItemHeight = 0 + MultiSelect = True + TabOrder = 6 + end + object ResetBtn: TButton + Left = 418 + Height = 27 + Top = 40 + Width = 72 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 7 + end + object CancelBtn: TButton + Left = 418 + Height = 27 + Top = 104 + Width = 72 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 8 + end + object ComputeBtn: TButton + Left = 418 + Height = 27 + Top = 169 + Width = 72 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 9 + end + object ReturnBtn: TButton + Left = 418 + Height = 27 + Top = 232 + Width = 72 + Caption = 'Return' + ModalResult = 1 + TabOrder = 10 + end + object CorrChk: TCheckBox + Left = 1 + Height = 19 + Top = 305 + Width = 121 + Caption = 'ShowCorrelograms' + TabOrder = 11 + end +end diff --git a/applications/lazstats/source/not used by LazStats/interruptedunit.lrs b/applications/lazstats/source/not used by LazStats/interruptedunit.lrs new file mode 100644 index 000000000..a18643967 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/interruptedunit.lrs @@ -0,0 +1,236 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TInterruptedFrm','FORMDATA',[ + 'TPF0'#15'TInterruptedFrm'#14'InterruptedFrm'#4'Left'#3#129#0#6'Height'#3'Q'#1 + +#3'Top'#3#129#0#5'Width'#3#25#2#5'Align'#7#8'alCustom'#8'AutoSize'#9#11'Bord' + +'erIcons'#11#12'biSystemMenu'#0#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6' ' + +'Interrupted Time Series Analysis'#12'ClientHeight'#3'Q'#1#11'ClientWidth'#3 + +#25#2#6'OnShow'#7#8'FormShow'#8'Position'#7#9'poDefault'#10'LCLVersion'#6#7 + +'2.1.0.0'#0#6'TLabel'#6'Label1'#4'Left'#2#2#6'Height'#2#15#3'Top'#2#0#5'Widt' + +'h'#2'a'#7'Caption'#6#19'Available Variables'#11'ParentColor'#8#0#0#6'TLabel' + +#6'Label2'#4'Left'#3#250#0#6'Height'#2#15#3'Top'#2#2#5'Width'#3#147#0#7'Capt' + +'ion'#6#26'Pre-Treatment Observations'#11'ParentColor'#8#0#0#6'TLabel'#6'Lab' + +'el3'#4'Left'#3#250#0#6'Height'#2#15#3'Top'#3#153#0#5'Width'#3#153#0#7'Capti' + +'on'#6#27'Post-Treatment Observations'#11'ParentColor'#8#0#0#8'TListBox'#7'V' + +'arList'#4'Left'#2#0#6'Height'#3#15#1#3'Top'#2#23#5'Width'#3#188#0#10'ItemHe' + +'ight'#2#0#11'MultiSelect'#9#8'TabOrder'#2#0#0#0#7'TBitBtn'#8'PreInBtn'#4'Le' + +'ft'#3#194#0#6'Height'#2#29#3'Top'#2#23#5'Width'#2'#'#10'Glyph.Data'#10':'#4 + +#0#0'6'#4#0#0'BM6'#4#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0' '#0 + +#0#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0#0#0#0#0#0#0#0#0#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0'!c$'#184#29'^ '#6#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0'*p/8%i)'#247'!c$'#217#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0'a'#190'm'#255']'#184'h'#255'X'#177'b'#255'S' + +#169'\'#255'M'#161'V'#255'G'#153'O'#255'A'#145'I'#255';'#136'B'#255'5'#128';' + +#255'?'#136'E'#255'Y'#161'^'#255'D'#139'I'#255'!c$'#207#255#255#255#0#255#255 + +#255#0#255#255#255#0'e'#195'q'#255#160#215#169#255#156#213#165#255#152#211 + +#161#255#148#208#157#255#144#206#152#255#139#203#147#255#135#201#142#255#130 + +#198#137#255'~'#195#132#255'z'#193#128#255'v'#190'|'#255'E'#140'J'#255'!c$' + +#196#255#255#255#0#255#255#255#0'h'#199't'#255#165#218#174#255#162#216#171 + +#255#158#214#167#255#154#212#163#255#150#210#159#255#147#207#154#255#142#204 + +#149#255#137#202#144#255#133#199#139#255#129#197#135#255'}'#194#130#255'J' + +#145'P'#255'%i)'#201#255#255#255#0#255#255#255#0'h'#199't'#255'h'#199't'#255 + +'e'#195'q'#255'a'#190'm'#255']'#184'h'#255'X'#177'b'#255'S'#169'\'#255'M'#161 + +'V'#255'G'#153'O'#255'A'#145'I'#255'Z'#163'b'#255'U'#157'\'#255'/x5'#209#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0'A'#145'I'#247';'#136'B'#219#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0'G'#153'O'#187'A'#145'I'#6#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#7'OnClick'#7#13'PreInBtnClick'#8'TabOrder'#2#1#0#0#7'TB' + ,'itBtn'#9'PreOutBtn'#4'Left'#3#194#0#6'Height'#2#29#3'Top'#2'@'#5'Width'#2'#' + +#10'Glyph.Data'#10':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#16 + +#0#0#0#16#0#0#0#1#0' '#0#0#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0#0#0#0#0#0#0#0#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0'M'#161'V'#6'G'#153'O'#184#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0'S'#169'\'#217'M'#161'V'#247'G'#153'O8' + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0']'#184'h'#207'q'#190'{'#255'z'#193#131#255'['#170'd'#255 + +'G'#153'O'#255'A'#145'I'#255';'#136'B'#255'5'#128';'#255'/x5'#255'*p/'#255'%' + +'i)'#255'!c$'#255#29'^ '#255#255#255#255#0#255#255#255#0'e'#195'q'#196'{'#200 + +#134#255#156#213#165#255#152#211#161#255#148#208#157#255#144#206#152#255#139 + +#203#147#255#135#201#142#255#130#198#137#255'~'#195#132#255'z'#193#128#255'v' + +#190'|'#255'r'#189'x'#255'!c$'#255#255#255#255#0#255#255#255#0'h'#199't'#201 + +#127#204#138#255#162#216#171#255#158#214#167#255#154#212#163#255#150#210#159 + +#255#147#207#154#255#142#204#149#255#137#202#144#255#133#199#139#255#129#197 + +#135#255'}'#194#130#255'x'#192'~'#255'%i)'#255#255#255#255#0#255#255#255#0 + +#255#255#255#0'h'#199't'#209#128#205#139#255'|'#201#135#255']'#184'h'#255'X' + +#177'b'#255'S'#169'\'#255'M'#161'V'#255'G'#153'O'#255'A'#145'I'#255';'#136'B' + +#255'5'#128';'#255'/x5'#255'*p/'#255#255#255#255#0#255#255#255#0#255#255#255 + +#0#255#255#255#0'h'#199't'#219'e'#195'q'#247#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0'h'#199't'#6'h'#199't'#187#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#7'OnClick'#7#14'PreOutBtnClick'#8 + +'TabOrder'#2#2#0#0#7'TBitBtn'#9'PostInBtn'#4'Left'#3#194#0#6'Height'#2#29#3 + +'Top'#3#169#0#5'Width'#2'#'#10'Glyph.Data'#10':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0 + +#0#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0#0#1#0' '#0#0#0#0#0#0#4#0#0'd'#0#0#0 + +'d'#0#0#0#0#0#0#0#0#0#0#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + ,#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0'!c$'#184#29'^ '#6#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0'*p/8%i)'#247'!c$'#217#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0'a'#190'm'#255']'#184'h'#255'X'#177'b'#255'S'#169'\'#255'M'#161'V' + +#255'G'#153'O'#255'A'#145'I'#255';'#136'B'#255'5'#128';'#255'?'#136'E'#255'Y' + +#161'^'#255'D'#139'I'#255'!c$'#207#255#255#255#0#255#255#255#0#255#255#255#0 + +'e'#195'q'#255#160#215#169#255#156#213#165#255#152#211#161#255#148#208#157 + +#255#144#206#152#255#139#203#147#255#135#201#142#255#130#198#137#255'~'#195 + +#132#255'z'#193#128#255'v'#190'|'#255'E'#140'J'#255'!c$'#196#255#255#255#0 + +#255#255#255#0'h'#199't'#255#165#218#174#255#162#216#171#255#158#214#167#255 + +#154#212#163#255#150#210#159#255#147#207#154#255#142#204#149#255#137#202#144 + +#255#133#199#139#255#129#197#135#255'}'#194#130#255'J'#145'P'#255'%i)'#201 + +#255#255#255#0#255#255#255#0'h'#199't'#255'h'#199't'#255'e'#195'q'#255'a'#190 + +'m'#255']'#184'h'#255'X'#177'b'#255'S'#169'\'#255'M'#161'V'#255'G'#153'O'#255 + +'A'#145'I'#255'Z'#163'b'#255'U'#157'\'#255'/x5'#209#255#255#255#0#255#255#255 + +#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0'A'#145'I'#247';'#136'B'#219#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0'G'#153'O'#187'A'#145'I'#6#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#7'OnClick'#7#14'PostInBtnClick'#8'TabOrder'#2#3#0#0#7'TBitBtn'#10'PostOutBt' + +'n'#4'Left'#3#194#0#6'Height'#2#29#3'Top'#3#208#0#5'Width'#2'#'#10'Glyph.Dat' + +'a'#10':'#4#0#0'6'#4#0#0'BM6'#4#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#16#0#0#0#16#0#0 + +#0#1#0' '#0#0#0#0#0#0#4#0#0'd'#0#0#0'd'#0#0#0#0#0#0#0#0#0#0#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0'M'#161'V'#6'G'#153'O'#184#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0'S'#169'\'#217'M'#161'V'#247'G'#153'O8'#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0']'#184'h'#207'q'#190'{'#255'z'#193#131#255'['#170'd'#255'G'#153'O'#255 + +'A'#145'I'#255';'#136'B'#255'5'#128';'#255'/x5'#255'*p/'#255'%i)'#255'!c$' + +#255#29'^ '#255#255#255#255#0#255#255#255#0'e'#195'q'#196'{'#200#134#255#156 + +#213#165#255#152#211#161#255#148#208#157#255#144#206#152#255#139#203#147#255 + ,#135#201#142#255#130#198#137#255'~'#195#132#255'z'#193#128#255'v'#190'|'#255 + +'r'#189'x'#255'!c$'#255#255#255#255#0#255#255#255#0'h'#199't'#201#127#204#138 + +#255#162#216#171#255#158#214#167#255#154#212#163#255#150#210#159#255#147#207 + +#154#255#142#204#149#255#137#202#144#255#133#199#139#255#129#197#135#255'}' + +#194#130#255'x'#192'~'#255'%i)'#255#255#255#255#0#255#255#255#0#255#255#255#0 + +'h'#199't'#209#128#205#139#255'|'#201#135#255']'#184'h'#255'X'#177'b'#255'S' + +#169'\'#255'M'#161'V'#255'G'#153'O'#255'A'#145'I'#255';'#136'B'#255'5'#128';' + +#255'/x5'#255'*p/'#255#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255 + +#0'h'#199't'#219'e'#195'q'#247#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +'h'#199't'#6'h'#199't'#187#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255 + +#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255 + +#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0#255#255#255#0 + +#255#255#255#0#255#255#255#0#7'OnClick'#7#15'PostOutBtnClick'#8'TabOrder'#2#4 + +#0#0#8'TListBox'#7'PreList'#4'Left'#3#239#0#6'Height'#2'v'#3'Top'#2#23#5'Wid' + +'th'#3#155#0#10'ItemHeight'#2#0#11'MultiSelect'#9#8'TabOrder'#2#5#0#0#8'TLis' + +'tBox'#8'PostList'#4'Left'#3#239#0#6'Height'#2#127#3'Top'#3#169#0#5'Width'#3 + +#158#0#10'ItemHeight'#2#0#11'MultiSelect'#9#8'TabOrder'#2#6#0#0#7'TButton'#8 + +'ResetBtn'#4'Left'#3#162#1#6'Height'#2#27#3'Top'#2'('#5'Width'#2'H'#7'Captio' + +'n'#6#5'Reset'#7'OnClick'#7#13'ResetBtnClick'#8'TabOrder'#2#7#0#0#7'TButton' + +#9'CancelBtn'#4'Left'#3#162#1#6'Height'#2#27#3'Top'#2'h'#5'Width'#2'H'#7'Cap' + +'tion'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#8#0#0#7'TButton'#10'Com' + +'puteBtn'#4'Left'#3#162#1#6'Height'#2#27#3'Top'#3#169#0#5'Width'#2'H'#7'Capt' + +'ion'#6#7'Compute'#7'OnClick'#7#15'ComputeBtnClick'#8'TabOrder'#2#9#0#0#7'TB' + +'utton'#9'ReturnBtn'#4'Left'#3#162#1#6'Height'#2#27#3'Top'#3#232#0#5'Width'#2 + +'H'#7'Caption'#6#6'Return'#11'ModalResult'#2#1#8'TabOrder'#2#10#0#0#9'TCheck' + +'Box'#7'CorrChk'#4'Left'#2#1#6'Height'#2#19#3'Top'#3'1'#1#5'Width'#2'y'#7'Ca' + +'ption'#6#16'ShowCorrelograms'#8'TabOrder'#2#11#0#0#0 +]); diff --git a/applications/lazstats/source/not used by LazStats/interruptedunit.pas b/applications/lazstats/source/not used by LazStats/interruptedunit.pas new file mode 100644 index 000000000..45b3db7c3 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/interruptedunit.pas @@ -0,0 +1,909 @@ +unit InterruptedUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, MainUnit, Globals, DataProcs, OutPutUnit, + AutoPlotUnit, GraphLib; + +type + + { TInterruptedFrm } + + TInterruptedFrm = class(TForm) + CorrChk: TCheckBox; + PreInBtn: TBitBtn; + PreOutBtn: TBitBtn; + PostInBtn: TBitBtn; + PostOutBtn: TBitBtn; + ResetBtn: TButton; + CancelBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + VarList: TListBox; + PreList: TListBox; + PostList: TListBox; + procedure ComputeBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure PostInBtnClick(Sender: TObject); + procedure PostOutBtnClick(Sender: TObject); + procedure PreInBtnClick(Sender: TObject); + procedure PreOutBtnClick(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure matinverse(Sender: TObject); + procedure plotit( Sender: TObject); + procedure PlotFuncs(Sender: TObject); + + private + { private declarations } + z : DblDyneVec; + y : DblDyneVec; + x : DblDyneMat; + x1 : array[1..4,1..4] of double; + x2 : array[1..4,1..4] of double; + x3 : array[1..4] of double; + t : array[1..4] of double; + p : array[1..100] of double; + p1 : array[1..4] of double; + ii3 : array[1..4,1..3] of double; + p2 : array[1..4] of double; + s : array[1..4] of double; + t2 : array[1..4] of double; + b : array[1..4,1..1] of double; + x4 : array[1..50,1..10] of double; + d : array[1..50,1..5] of double; + r : array[1..50] of double; + x5 : array[1..50,1..11] of double; + a1 : array[1..10] of double; + a2 : array[1..10] of double; + r2 : array[1..10] of double; + e : array[1..10] of double; + f2 : array[1..5,1..10] of double; + pl : string; + f1s, g1s, g2s, g3s, g4s, g5s, g6s, g7s, g8s : string; + c9, g, c, g1, t3, t4, t5, t6, f4, n7, d7, y1, xx3, f1, f2x, s1 : double; + s3, s4, h, f3, y2, a, det, amax : double; + col, n, n1, n2, n4, n5, n6, m, l1, l2, i3, t1, NoGoodCases : integer; + n3, j1, m1, i1, R1 : integer; + + public + { public declarations } + end; + +var + InterruptedFrm: TInterruptedFrm; + +implementation + +{ TInterruptedFrm } + +procedure TInterruptedFrm.ResetBtnClick(Sender: TObject); +VAR i : integer; +begin + VarList.Clear; + PreList.Clear; + PostList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + PreOutBtn.Visible := false; + PostOutBtn.Visible := false; + PreInBtn.Visible := true; + PostInBtn.Visible := true; +end; + +procedure TInterruptedFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(Self); +end; + +procedure TInterruptedFrm.ComputeBtnClick(Sender: TObject); +label 300; +var + i, i2, j, j2, j3, k : integer; + ColNoSelected : IntDyneVec; + rxy : DblDyneVec; + heading : string; +begin + g1s := 't..change in level '; + g2s := 't..change in slope '; + g3s := 'scaled posterior '; + g4s := 'lower 99 percent '; + g5s := 'lower 95 percent '; + g6s := 'delta '; + g7s := 'upper 95 percent '; + g8s := 'upper 99 percent '; + c9 := 1.0E-15; + n1 := 0; + n2 := 0; + g := 0.01; + NoGoodCases := 0; + OutPutFrm.RichEdit.Clear; + OutPutFrm.RichEdit.Lines.Add('Interrupted Time Series Analysis'); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('Adapted from the Fortran program written by Glass and Maguire'); + OutPutFrm.RichEdit.Lines.Add('and based on Box and Tiao IMA(1,1) procedure. Published in'); + OutPutFrm.RichEdit.Lines.Add('How To Do Psychotherapy and How to Evaluate It by'); + OutPutFrm.RichEdit.Lines.Add('John M. Gottman and Sandra R. Leiblum, Holt, Rinehart and '); + OutPutFrm.RichEdit.Lines.Add('Winston, Inc., New York, 1974.'); + OutPutFrm.RichEdit.Lines.Add(''); + n1 := PreList.Items.Count; + n2 := PostList.Items.Count; + t1 := n1 + n2; + if t1 < 5 then + begin + ShowMessage('There must be more than 4 total values in the series.'); + exit; + end; + // allocate space + SetLength(z,t1); + SetLength(y,t1); + SetLength(x,t1,4); + SetLength(ColNoSelected,t1); + SetLength(rxy,t1); + + // Get column numbers of variables selected + for i := 1 to n1 do + begin + for j := 1 to NoVariables do + begin + if PreList.Items.Strings[i-1] = OS3MainFrm.DataGrid.Cells[j,0] then + ColNoSelected[i-1] := j; + end; + end; + for i := 1 to n2 do + begin + for j := 1 to NoVariables do + begin + if PostList.Items.Strings[i-1] = OS3MainFrm.DataGrid.Cells[j,0] then + ColNoSelected[n1+i-1] := j; + end; + end; + + // read pre and post values - average for the cases + for j := 0 to t1-1 do z[j] := 0.0; + for i := 1 to NoCases do + begin + if NOT GoodRecord(i,t1,ColNoSelected) then continue; + for j := 0 to t1-1 do + begin + col := ColNoSelected[j]; + z[j] := z[j] + StrToFloat(OS3MainFrm.DataGrid.Cells[col,i]); + NoGoodCases := NoGoodCases + 1; + end; + end; + for j := 0 to t1-1 do z[j] := z[j] / NoGoodCases; + + // plot correlograms + for j3 := 1 to 4 do + begin + case j3 of + 1 : begin + f1s := 'Pre-Treatment Data'; + n4 := n1; + l1 := 1; + l2 := n1; + OutPutFrm.RichEdit.Lines.Add('Correlogram of Pre-Treatment Raw Data'); + heading := 'Correlogram of Pre-Treatment Raw Data'; + i2 := 0; + for i := l1 to l2 do + begin + i2 := i2 + 1; + y[i2-1] := z[i-1]; + end; + end; + 2 : begin + f1s := 'Post-Treatment Data'; + n4 := n2; + l1 := n1 + 1; + l2 := t1; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('Correlogram of Post-Treatment Raw Data'); + heading := 'Correlogram of Post-Treatment Raw Data'; + i2 := 0; + for i := l1 to l2 do + begin + i2 := i2 + 1; + y[i2-1] := z[i-1]; + end; + end; + 3 : begin + f1s := 'Pre-Treatment Data'; + n4 := n1 - 1; + l1 := 1; + l2 := n1 - 1; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('Correlogram of Pre-Treatment Differences'); + heading := 'Correlogram of Pre-Treatment Differences'; + i2 := 0; + for i := l1 to l2 do + begin + i2 := i2 + 1; + i3 := i + 1; + y[i2-1] := z[i3-1] - z[i-1]; + end; + end; + 4 : begin + f1s := 'Post-Treatment Data'; + n4 := n2-1; + l1 := n1 + 1; + l2 := t1 - 1; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add('Correlogram of Post-Treatment Differences'); + heading := 'Correlogram of Post-Treatment Differences'; + i2 := 0; + for i := l1 to l2 do + begin + i2 := i2 + 1; + i3 := i + 1; + y[i2-1] := z[i3-1] - z[i-1]; + end; + end; + end; + j2 := n4 * 3 div 4; + for k := 1 to j2 do + begin + n5 := n4 - k; + c := 0.0; + t3 := 0.0; + t4 := 0.0; + t5 := 0.0; + t6 := 0.0; + for i := 1 to n5 do + begin + n6 := i + k; + c := c + y[i-1] * y[n6-1]; + t3 := t3 + y[i-1]; + t4 := t4 + y[n6-1]; + t5 := t5 + y[i-1] * y[i-1]; + t6 := t6 + y[n6-1] * y[n6-1]; + end; + f4 := n5; + n7 := c - (t3 * t4) / f4; + d7 := (t5 - (t3 * t3) / f4) * (t6 - (t4 * t4) / f4); + if d7 > 0.0 then + begin + d7 := sqrt(d7); + r[k] := n7 / d7; + end + else r[k] := 1.0; + pl := format('lag %3d r %4.2f',[k,r[k]]); + OutPutFrm.RichEdit.Lines.Add(pl); + end; // next k + s4 := 1; + n := 1; + m := j2; + for i := 1 to j2 do x4[i,1] := r[i]; +// plotit(Self); + if CorrChk.Checked then + begin + rxy[0] := 0.0; + for i := 1 to j2 do rxy[i] := r[i]; + AutoPlotFrm.PlotPartCors := false; + AutoPlotFrm.PlotLimits := false; + AutoPlotFrm.correlations := rxy; + AutoPlotFrm.partcors := rxy; + AutoPlotFrm.uplimit := 0.99; + AutoPlotFrm.lowlimit := -0.99; + AutoPlotFrm.npoints := j2+1; + AutoPlotFrm.DepVarEdit := heading; + AutoPlotFrm.ShowModal; + end; + end; // next j3 + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + + // Now do the analysis + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add(' residual t for change in t for'); + OutPutFrm.RichEdit.Lines.Add(' gamma variance level level level change'); +300: + y[0] := z[0]; + for i := 1 to t1-1 do + begin + i1 := i - 1; + y1 := abs(y[i1]); + if (y1 - c9) <= 0.0 then y[i] := z[i] - z[i1] + else if (y1 - 0.000001) > 0 then y[i] := (z[i] - z[i1]) + (1.0 - g) * y[i1]; + g1 := abs(1.0 - g); + if (g1 - 0.001) > 0 then y[i] := (z[i] - z[i1]) + (1.0 - g) * y[i1] + else y[i] := z[i] - z[i1]; + end; + for i := 0 to t1 - 1 do x[i,0] := 1; + for i := 1 to n1 do x[i-1,1] := 0.0; + for i := n1 + 1 to t1 do x[i-1,1] := 1.0; + x[0,2] := 1.0; + x[1,2] := 1.0 - g; + for i := 2 to t1-1 do + begin + i1 := i - 1; + x[i,2] := x[1,2] * x[i1,2]; + xx3 := abs(x[i,2]); + if (c9 - xx3) <= 0.0 then continue; + x[i,2] := 0.0; + end; + for i := 1 to n1 do x[i-1,3] := 0.0; + for i := n1 to t1-1 do + begin + i1 := i-n1; + x[i,3] := x[i1,2]; + xx3 := abs(x[i,3]); + if (c9 - xx3) <= 0.0 then continue; + x[i,3] := 0.0; + end; + for i := 1 to 4 do + begin + for j := 1 to 4 do + begin + x2[i,j] := 0.0; + x1[i,j] := 0.0; + end; + end; + for i := 1 to 4 do + for j := 1 to 4 do + for k := 1 to t1 do + x2[i,j] := x2[i,j] + x[k-1,i-1] * x[k-1,j-1]; + for i := 1 to 4 do + for j := 1 to 4 do + x1[i,j] := x2[i,j]; + for i := 1 to 4 do x3[i] := 0.0; + for i := 1 to 4 do + for j := 1 to t1 do + x3[i] := x3[i] + x[j-1,i-1] * y[j-1]; + for i := 1 to 4 do b[i,1] := x3[i]; + matinverse(Self); + for i := 1 to 4 do t[i] := b[i,1]; + for i := 1 to 4 do s[i] := x1[i,i]; + f1 := t1; + y1 := 0.0; + for i := 0 to t1-1 do + begin + y1 := y1 + y[i] * y[i]; + end; + for i := 1 to 4 do x3[i] := 0.0; + for j := 1 to 4 do + for i := 1 to 4 do + begin + x3[j] := x3[j] + t[i] * x2[i,j]; + end; + f2x := 0.0; + for i := 1 to 4 do + begin + f2x := f2x + x3[i] * t[i]; + end; + s1 := y1 - f2x; + s1 := s1 / (f1 - 4.0); + for i := 1 to 4 do + begin + s[i] := sqrt(s1 * s[i]); + t2[i] := t[i] / s[i]; + end; + s3 := ln(s1); + det := ln(det); + h := (-0.5 * det) - (0.5 * (f1 - 4.0) * s3); + h := 0.4342945 * h; + j1 := j1 + 1; + x5[j1,1] := g; + x5[j1,2] := s1; + x5[j1,3] := t[3]; + x5[j1,4] := t2[3]; + x5[j1,5] := t[4]; + x5[j1,6] := t2[4]; + x5[j1,7] := t[1]; + x5[j1,8] := t2[1]; + x5[j1,9] := t[2]; + x5[j1,10] := t2[2]; + if (t1 - 30) >= 0 then + begin + d[j1,1] := t[4] - 2.58 * s[4]; + d[j1,2] := t[4] - 1.96 * s[4]; + d[j1,3] := t[4]; + d[j1,4] := t[4] + 1.96 * s[4]; + d[j1,5] := t[4] + 2.58 * s[4]; + end; + n3 := n3 + 1; + p[n3] := h; + g := g + 0.04; + if (n3 - 49) <= 0 then goto 300; + f3 := p[1]; + for i := 2 to 49 do if (f3 - p[i]) < 0 then f3 := p[i]; + for i := 1 to 49 do + begin + p[i] := p[i] - f3; + y2 := abs(p[i]); + if (y2 - 35) >= 0 then p[i] := 0.0 + else begin + p[i] := p[i] / 0.4342945; + p[i] := exp(p[i]); + end; + end; + a := 0.0; + for i := 2 to 49 do + begin + i2 := i - 1; + a := a + 0.005 * (p[i] + p[i1]); + end; + for i := 1 to 49 do p[i] := p[i] / a; + for i := 1 to 49 do x5[i,11] := p[i]; + for i := 1 to 49 do + begin + pl := format('%2d ',[i]); + for j := 1 to 6 do + pl := pl + format('%6.2f ',[x5[i,j]]); + OutPutFrm.RichEdit.Lines.Add(pl); + end; + + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add(''); + pl := ' t for change in t for scaled'; + OutPutFrm.RichEdit.Lines.Add(pl); + pl := ' slope slope slope change posterior'; + OutPutFrm.RichEdit.Lines.Add(pl); + for i := 1 to 49 do + begin + pl := format('%2d ',[i]); + for j := 7 to 11 do + pl := pl + format('%6.2f ',[x5[i,j]]); + OutPutFrm.RichEdit.Lines.Add(pl); + end; + + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add(''); + for i := 1 to 49 do + begin + x4[i,1] := x5[i,5]; + x4[i,2] := x5[i,9]; + x4[i,3] := x5[i,11]; + end; + m := 49; + n := 3; + i3 := 1; + f1s := g1s + g2s + g3s; + PlotFuncs(Self); + plotit(Self); // plot the f[i,j] values + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; + n := 5; + if (t1 - 30) >= 0 then + begin // do confidence intervals around delta + for i := 1 to 49 do + for j := 1 to 5 do + x4[i,j] := d[i,j]; + f1s := g4s + g5s + g6s + g7s + g8s; + pl := 'Confidence Intervals Around Delta'; + OutPutFrm.RichEdit.Lines.Add(pl); + pl := 'gamma lower 99 lower 95 delta upper 95 upper 99'; + OutPutFrm.RichEdit.Lines.Add(pl); + for i := 1 to 49 do + begin + pl := format('%6.2f ',[x5[i,1]]); + for j := 1 to 5 do + pl := pl + format('%6.2f ',[d[i,j]]); + OutPutFrm.RichEdit.Lines.Add(pl); + end; + OutPutFrm.RichEdit.Lines.Add(''); + pl := 'Graph of Confidence Intervals Around Delta Hat'; + OutPutFrm.RichEdit.Lines.Add(pl); + plotit(Self); // plot f matrix + end; + + OutPutFrm.ShowModal; + + // clean up + rxy := nil; + ColNoSelected := nil; + x := nil; + y := nil; + z := nil; +end; + +procedure TInterruptedFrm.PostInBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.Count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + PostList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + PostOutBtn.Visible := true; + if VarList.Items.Count = 0 then PostInBtn.Visible := false; +end; + +procedure TInterruptedFrm.PostOutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := PostList.ItemIndex; + if index >= 0 then + begin + VarList.Items.Add(PostList.Items.Strings[index]); + PostList.Items.Delete(index); + PostInBtn.Visible := true; + if PostList.Items.Count = 0 then PostOutBtn.Visible := false; + end; +end; + +procedure TInterruptedFrm.PreInBtnClick(Sender: TObject); +VAR i, index : integer; +begin + index := VarList.Items.count; + i := 0; + while i < index do + begin + if (VarList.Selected[i]) then + begin + PreList.Items.Add(VarList.Items.Strings[i]); + VarList.Items.Delete(i); + index := index - 1; + i := 0; + end + else i := i + 1; + end; + PreOutBtn.Visible := true; + if VarList.Items.Count = 0 then PreInBtn.Visible := false; +end; + +procedure TInterruptedFrm.PreOutBtnClick(Sender: TObject); +VAR index : integer; +begin + index := PreList.ItemIndex; + if index >= 0 then + begin + VarList.Items.Add(PreList.Items.Strings[index]); + PreList.Items.Delete(index); + PreInBtn.Visible := true; + if PreList.Items.Count = 0 then PreOutBtn.Visible := false; + end; +end; + +procedure TInterruptedFrm.matinverse(Sender: TObject); +var + i, j, j2, j4, k, L, Lc : integer; + temp : double; +begin + //Matrix inverse and determinant + + det := 1; + m1 := 1; + N := 4; + For i := 1 To 4 do + begin + p1[i] := 0.0; + For j := 1 To 2 do ii3[i, j] := 0.0; + end; + For i := 1 To N do + begin + amax := 0.0; + For j := 1 To N do + begin + If (p1[j] - 1) <> 0 Then + begin + For k := 1 To N do + begin + If (p1[k] - 1) <> 0 Then + begin + If (p1[k] - 1) > 0 Then Exit; + If Abs(amax) - Abs(x1[j, k]) <= 0 Then + begin + R1 := j; + i1 := k; + amax := x1[j, k]; + End; + End; + end; + End; + end; + p1[i1] := p1[i1] + 1; + If (R1 - i1) <> 0 Then //Swap + begin + det := -det; + For L := 1 To N do + begin + s4 := x1[R1, L]; + x1[R1, L] := x1[i1, L]; + x1[i1, L] := s4; + end; + If m1 > 0 Then //Swap + begin + For L := 1 To m1 do + begin + s4 := b[R1, L]; + b[R1, L] := b[i1, L]; + b[i1, L] := s4; + end; + End; + End; + ii3[i, 1] := R1; + ii3[i, 2] := i1; + p2[i] := x1[i1, i1]; + det := det * p2[i]; + If p2[i] = 0 Then + begin + ShowMessage('A singular matrix was found.'); + Exit; + End; + x1[i1, i1] := 1; + For L := 1 To N do + begin + x1[i1, L] := x1[i1, L] / p2[i]; + end; + If m1 > 0 Then + begin + For L := 1 To m1 do + begin + b[i1, L] := b[i1, L] / p2[i]; + end; + End; + For Lc := 1 To N do + begin + If (Lc - i1) <> 0 Then + begin + temp := x1[Lc,i1]; + x1[L1,i1] := 0.0; + For L := 1 To N do + begin + x1[Lc,L] := x1[Lc,L] - x1[i1,L] * temp; + end; + If m1 > 0 Then + begin + For L := 1 To m1 do + b[L1, L] := b[L1, L] - b[i1, L] * temp; + End; + End; + end; + end; + For i := 1 To N do + begin + L := N + 1 - i; + If (ii3[L, 1] - ii3[L, 2]) <> 0 Then + begin + j2 := round(ii3[L, 1]); + j4 := round(ii3[L, 2]); + For k := 1 To N do + begin + s4 := x1[k, j2]; + x1[k, j2] := x1[k, j4]; + x1[k, j4] := s4; + end; + End; + end; +end; +//-------------------------------------------------------------------- + +procedure TInterruptedFrm.plotit( Sender: TObject); +label 2180, 2660; +var + i, i2, ip, j, k, L, n8 : integer; + bstr, p1str, p2str : string; + c5, z2 : double; + +begin + For i := 1 To N do + begin + a1[i] := 1E+37; + a2[i] := -1E+37; + end; + bstr := '153510cmha'; + For i := 1 To M do + begin + For j := 1 To N do + begin + c5 := x4[i, j] - a1[j]; + If c5 >= 0 Then goto 2180; + a1[j] := x4[i, j]; +2180: c5 := x4[i, j] - a2[j]; + If c5 <= 0 Then continue; + a2[j] := x4[i, j]; + end; + end; + If (N - 5) = 0 Then + begin + For j := 1 To 5 do + begin + a2[j] := a2[5]; + a1[j] := a1[1]; + end; + End; + n8 := N; + For j := 1 To N do + begin + r2[j] := (a2[j] - a1[j]) / 55; + end; + For j := 1 To N do + begin + e[j] := (a2[j] - a1[j]) / 4; + f2[1, j] := a1[j] + 0.05; + c5 := a1[j]; + If c5 < 0 Then + begin + f2[1, j] := f2[1, j] - 0.1; + End; + f2[5, j] := a2[j] - 0.05; + c5 := a2[j]; + If c5 < 0 Then + begin + f2[5, j] := f2[5, j] - 0.1; + End; + f2[2, j] := a1[j] + e[j] + 0.05; + c5 := f2[2, j]; + If c5 < 0 Then + begin + f2[2, j] := f2[2, j] - 0.1; + End; + f2[3, j] := a1[j] + e[j] * 2 + 0.05; + c5 := f2[3, j]; + If c5 < 0 Then + begin + f2[3, j] := f2[3, j] - 0.1; + End; + f2[4, j] := a2[j] - e[j] + 0.05; + c5 := f2[4, j]; + If c5 < 0 Then + begin + f2[4, j] := f2[4, j] - 0.1; + End; + end; + + For j := 1 To n8 do + begin + pl := bstr[j] + ' '; + For i := 1 To 5 do + begin + pl := pl + format('%6.2f ',[f2[i,j]]); + end; + pl := pl + copy(bstr, j, 1); + OutPutFrm.RichEdit.Lines.Add(pl); + end; + pl := ''; + OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------------'); + + for i2 := 1 to 73 do + begin + p2str := p2str + ' '; + p1str := p1str + ' '; + end; + For i := 1 To M do + begin + For i2 := 1 To 72 do p1str[i2] := ' '; + k := 0; + p1str[1] := '.'; + For i2 := 1 To 5 do + begin + k := k + 14; + p1str[k] := '.'; + end; + n7 := i; + while N7 >= 0 do + begin + n7 := n7 - 10; + end; + If n7 >= 0 Then + begin + k := 3; + p1str[k] := '-'; + For i2 := 3 To 30 do + begin + k := k + 2; + p1str[k] := '-'; + end; + End; + For k := 1 To N do + begin + If r2[k] > 0 Then + z2 := (x4[i, k] - a1[k]) / r2[k] + 1 + Else z2 := 0; + L := round(z2); + If (L - 1) < 0 Then L := 1; + If (55 - L) < 0 Then L := 55; + If (p1str[L] = ' ') Or (p1str[L] = '.') Or (p1str[L] = '-') Then + begin + p2str[k] := bstr[k]; + p1str[L] := p2str[k]; + end + Else begin + p1str[L] := '+'; + End; + end; + If (s4 - 1) = 0 Then goto 2660; + OutPutFrm.RichEdit.Lines.Add(''); +2660: + pl := format('%2d. ',[i]); + For ip := 1 To 55 do pl := pl + p1str[ip]; + pl := pl + format('. %2d',[i]); + OutPutFrm.RichEdit.Lines.Add(pl); + end; + OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------------'); + OutPutFrm.RichEdit.Lines.Add(''); + For j := 1 To n8 do + begin + pl := bstr[j] + ' '; + For i := 1 To 5 do + begin + pl := pl + format('%6.2f ',[f2[i,j]]); + end; + pl := pl + bstr[j]; + OutPutFrm.RichEdit.Lines.Add(pl); + end; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add(' Plot Description'); + OutPutFrm.RichEdit.Lines.Add('title character minimum maximum resolution'); + + For j := 1 To N do + begin + pl := copy(f1s,j*20-19,20); + pl := pl + ' ' + bstr[j]; + pl := pl + ' ' + format('%6.2f',[a1[j]]); + pl := pl + ' ' + format('%6.2f',[a2[j]]); + pl := pl + ' ' + format('%6.2f',[r2[j]]); + OutPutFrm.RichEdit.Lines.Add(pl); + end; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add(''); +end; +//------------------------------------------------------------------- + +procedure TInterruptedFrm.PlotFuncs(Sender: TObject); +var + i, j : integer; + title : string; + gamma : double; +begin + // Allocate space for point sets of means + SetLength(GraphFrm.Ypoints,3,50); + SetLength(GraphFrm.Xpoints,3,50); + // store points for means + gamma := 0.0; + for i := 1 to 49 do + begin + for j := 1 to 3 do + begin + GraphFrm.Ypoints[j-1,i-1] := x4[i,j]; + GraphFrm.Xpoints[j-1,i-1] := gamma; + end; + gamma := gamma + 0.04; + end; + title := 'Plot of ts for change in level and slope and posterior'; + GraphFrm.nosets := 3; + GraphFrm.nbars := 49; + GraphFrm.Heading := title; + GraphFrm.SetLabels[1] := 'level'; + GraphFrm.SetLabels[2] := 'slope'; + GraphFrm.SetLabels[3] := 'posterior'; + GraphFrm.XTitle := 'Gamma Increment'; + GraphFrm.YTitle := 't'; + GraphFrm.barwideprop := 0.5; + GraphFrm.AutoScale := true; + GraphFrm.GraphType := 5; // 2d line chart + GraphFrm.BackColor := clYellow; + GraphFrm.WallColor := clBlack; + GraphFrm.FloorColor := clLtGray; + GraphFrm.ShowBackWall := true; + GraphFrm.ShowModal; + + GraphFrm.Xpoints := nil; + GraphFrm.Ypoints := nil; +end; + +initialization + {$I interruptedunit.lrs} + +end. + diff --git a/applications/lazstats/source/not used by LazStats/limitedunit.lfm b/applications/lazstats/source/not used by LazStats/limitedunit.lfm new file mode 100644 index 000000000..6243fcbe2 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/limitedunit.lfm @@ -0,0 +1,34 @@ +object LimitedForm: TLimitedForm + Left = 290 + Height = 192 + Top = 175 + Width = 400 + Caption = 'UNAVAILABLE IN THIS LIMITED VERSION' + ClientHeight = 192 + ClientWidth = 400 + LCLVersion = '2.1.0.0' + object Memo1: TMemo + Left = 6 + Height = 120 + Top = 8 + Width = 384 + Lines.Strings = ( + 'This procedure is not implimented in this limited' + 'version. The full version for Windows and Linux' + 'systems can be purchased at:' + 'http://www.statprograms4U.com' + 'If you have any questions, send an email to me' + 'at billmiller50322@gmail.com' + ) + TabOrder = 0 + end + object ReturnBtn: TButton + Left = 104 + Height = 35 + Top = 143 + Width = 146 + Caption = 'RETURN' + ModalResult = 1 + TabOrder = 1 + end +end diff --git a/applications/lazstats/source/not used by LazStats/limitedunit.lrs b/applications/lazstats/source/not used by LazStats/limitedunit.lrs new file mode 100644 index 000000000..5d99b5f3e --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/limitedunit.lrs @@ -0,0 +1,15 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TLimitedForm','FORMDATA',[ + 'TPF0'#12'TLimitedForm'#11'LimitedForm'#4'Left'#3'"'#1#6'Height'#3#192#0#3'To' + +'p'#3#175#0#5'Width'#3#144#1#7'Caption'#6'#UNAVAILABLE IN THIS LIMITED VERSI' + +'ON'#12'ClientHeight'#3#192#0#11'ClientWidth'#3#144#1#10'LCLVersion'#6#7'2.1' + +'.0.0'#0#5'TMemo'#5'Memo1'#4'Left'#2#6#6'Height'#2'x'#3'Top'#2#8#5'Width'#3 + +#128#1#13'Lines.Strings'#1#6'1This procedure is not implimented in this limi' + +'ted'#6'0version. The full version for Windows and Linux'#6#28'systems can ' + +'be purchased at:'#6#29'http://www.statprograms4U.com'#6'.If you have any qu' + +'estions, send an email to me'#6#28'at billmiller50322@gmail.com'#0#8'TabOrd' + +'er'#2#0#0#0#7'TButton'#9'ReturnBtn'#4'Left'#2'h'#6'Height'#2'#'#3'Top'#3#143 + +#0#5'Width'#3#146#0#7'Caption'#6#6'RETURN'#11'ModalResult'#2#1#8'TabOrder'#2 + +#1#0#0#0 +]); diff --git a/applications/lazstats/source/not used by LazStats/limitedunit.pas b/applications/lazstats/source/not used by LazStats/limitedunit.pas new file mode 100644 index 000000000..3f43c7178 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/limitedunit.pas @@ -0,0 +1,33 @@ +unit LimitedUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls; + +type + + { TLimitedForm } + + TLimitedForm = class(TForm) + ReturnBtn: TButton; + Memo1: TMemo; + private + { private declarations } + public + { public declarations } + end; + +var + LimitedForm: TLimitedForm; + +implementation + +initialization + {$I limitedunit.lrs} + +end. + diff --git a/applications/lazstats/source/not used by LazStats/presentvalueunit.lfm b/applications/lazstats/source/not used by LazStats/presentvalueunit.lfm new file mode 100644 index 000000000..f19a3edd9 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/presentvalueunit.lfm @@ -0,0 +1,167 @@ +object PresentValueFrm: TPresentValueFrm + Left = 163 + Height = 480 + Top = 111 + Width = 336 + Caption = 'Present Value' + ClientHeight = 480 + ClientWidth = 336 + OnShow = FormShow + LCLVersion = '2.1.0.0' + object Label1: TLabel + Left = 7 + Height = 15 + Top = 288 + Width = 65 + Caption = 'Future Value' + ParentColor = False + end + object Label2: TLabel + Left = 8 + Height = 15 + Top = 321 + Width = 47 + Caption = 'Payment' + ParentColor = False + end + object Label3: TLabel + Left = 8 + Height = 15 + Top = 354 + Width = 100 + Caption = 'Number of Periods' + ParentColor = False + end + object Label4: TLabel + Left = 8 + Height = 15 + Top = 392 + Width = 80 + Caption = 'Rate Per Period' + ParentColor = False + end + object Label5: TLabel + Left = 8 + Height = 15 + Top = 431 + Width = 70 + Caption = 'Present Value' + ParentColor = False + end + object Memo1: TMemo + Left = 6 + Height = 240 + Top = 8 + Width = 318 + Lines.Strings = ( + 'Description:' + '' + 'This procedure calculates the Present Value of an investment' + 'where Payment is received for N periods and is discounted at' + 'the rate of Rate per period. Future Value is the value the' + 'investment may reach at some point. Payment Time indicates' + 'whether the cash flow occurs at the beginning or end of the' + 'period.' + 'EXAMPLE: What was the amount borrowed in a 7.5% APR' + '(Annual Percentage Rate) four year auto loan when the' + 'payment is $500.00?' + 'Rate per Period = 0.075 / 12 = 0.00625' + 'Number of periods = 4 years * 12 months = 48' + 'Payment = -$500.00' + 'Future Value = 0' + 'Payment Time = End of Period' + 'ANSWER: about $20679.19' + ) + TabOrder = 0 + end + object FutureEdit: TEdit + Left = 104 + Height = 23 + Top = 281 + Width = 68 + TabOrder = 1 + Text = 'FutureEdit' + end + object PaymentEdit: TEdit + Left = 104 + Height = 23 + Top = 314 + Width = 68 + TabOrder = 2 + Text = 'Edit1' + end + object NPeriodsEdit: TEdit + Left = 104 + Height = 23 + Top = 347 + Width = 68 + TabOrder = 3 + Text = 'Edit1' + end + object RateEdit: TEdit + Left = 104 + Height = 23 + Top = 384 + Width = 68 + TabOrder = 4 + Text = 'Edit1' + end + object PresentEdit: TEdit + Left = 104 + Height = 23 + Top = 424 + Width = 68 + TabOrder = 5 + Text = 'Edit1' + end + object PayTimeGrp: TRadioGroup + Left = 191 + Height = 62 + Top = 272 + Width = 131 + AutoFill = True + Caption = 'Payment Time:' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 42 + ClientWidth = 127 + Items.Strings = ( + 'Start of Period' + 'End of Period' + ) + TabOrder = 6 + end + object ResetBtn: TButton + Left = 208 + Height = 34 + Top = 344 + Width = 85 + Caption = 'Reset' + OnClick = ResetBtnClick + TabOrder = 7 + end + object ComputeBtn: TButton + Left = 208 + Height = 34 + Top = 392 + Width = 85 + Caption = 'Compute' + OnClick = ComputeBtnClick + TabOrder = 8 + end + object ReturnBtn: TButton + Left = 208 + Height = 34 + Top = 440 + Width = 85 + Caption = 'Return' + ModalResult = 1 + TabOrder = 9 + end +end diff --git a/applications/lazstats/source/not used by LazStats/presentvalueunit.lrs b/applications/lazstats/source/not used by LazStats/presentvalueunit.lrs new file mode 100644 index 000000000..231fcc3df --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/presentvalueunit.lrs @@ -0,0 +1,50 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TPresentValueFrm','FORMDATA',[ + 'TPF0'#16'TPresentValueFrm'#15'PresentValueFrm'#4'Left'#3#163#0#6'Height'#3 + +#224#1#3'Top'#2'o'#5'Width'#3'P'#1#7'Caption'#6#13'Present Value'#12'ClientH' + +'eight'#3#224#1#11'ClientWidth'#3'P'#1#6'OnShow'#7#8'FormShow'#10'LCLVersion' + +#6#7'2.1.0.0'#0#6'TLabel'#6'Label1'#4'Left'#2#7#6'Height'#2#15#3'Top'#3' '#1 + +#5'Width'#2'A'#7'Caption'#6#12'Future Value'#11'ParentColor'#8#0#0#6'TLabel' + +#6'Label2'#4'Left'#2#8#6'Height'#2#15#3'Top'#3'A'#1#5'Width'#2'/'#7'Caption' + +#6#7'Payment'#11'ParentColor'#8#0#0#6'TLabel'#6'Label3'#4'Left'#2#8#6'Height' + +#2#15#3'Top'#3'b'#1#5'Width'#2'd'#7'Caption'#6#17'Number of Periods'#11'Pare' + +'ntColor'#8#0#0#6'TLabel'#6'Label4'#4'Left'#2#8#6'Height'#2#15#3'Top'#3#136#1 + +#5'Width'#2'P'#7'Caption'#6#15'Rate Per Period'#11'ParentColor'#8#0#0#6'TLab' + +'el'#6'Label5'#4'Left'#2#8#6'Height'#2#15#3'Top'#3#175#1#5'Width'#2'F'#7'Cap' + +'tion'#6#13'Present Value'#11'ParentColor'#8#0#0#5'TMemo'#5'Memo1'#4'Left'#2 + +#6#6'Height'#3#240#0#3'Top'#2#8#5'Width'#3'>'#1#13'Lines.Strings'#1#6#12'Des' + +'cription:'#6#0#6''#3'Top'#3#16#1#5'Width'#3#131#0#8'AutoFill'#9#7 + +'Caption'#6#13'Payment Time:'#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildS' + +'izing.TopBottomSpacing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomog' + +'enousChildResize'#27'ChildSizing.EnlargeVertical'#7#24'crsHomogenousChildRe' + +'size'#28'ChildSizing.ShrinkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.' + +'ShrinkVertical'#7#14'crsScaleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToR' + +'ightThenTopToBottom'#27'ChildSizing.ControlsPerLine'#2#1#12'ClientHeight'#2 + +'*'#11'ClientWidth'#2#127#13'Items.Strings'#1#6#15'Start of Period'#6#13'End' + +' of Period'#0#8'TabOrder'#2#6#0#0#7'TButton'#8'ResetBtn'#4'Left'#3#208#0#6 + +'Height'#2'"'#3'Top'#3'X'#1#5'Width'#2'U'#7'Caption'#6#5'Reset'#7'OnClick'#7 + +#13'ResetBtnClick'#8'TabOrder'#2#7#0#0#7'TButton'#10'ComputeBtn'#4'Left'#3 + +#208#0#6'Height'#2'"'#3'Top'#3#136#1#5'Width'#2'U'#7'Caption'#6#7'Compute'#7 + +'OnClick'#7#15'ComputeBtnClick'#8'TabOrder'#2#8#0#0#7'TButton'#9'ReturnBtn'#4 + +'Left'#3#208#0#6'Height'#2'"'#3'Top'#3#184#1#5'Width'#2'U'#7'Caption'#6#6'Re' + +'turn'#11'ModalResult'#2#1#8'TabOrder'#2#9#0#0#0 +]); diff --git a/applications/lazstats/source/not used by LazStats/presentvalueunit.pas b/applications/lazstats/source/not used by LazStats/presentvalueunit.pas new file mode 100644 index 000000000..38f828f65 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/presentvalueunit.pas @@ -0,0 +1,99 @@ +unit PresentValueUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls; + +type + + { TPresentValueFrm } + + TPresentValueFrm = class(TForm) + ResetBtn: TButton; + ComputeBtn: TButton; + ReturnBtn: TButton; + FutureEdit: TEdit; + PaymentEdit: TEdit; + NPeriodsEdit: TEdit; + RateEdit: TEdit; + PresentEdit: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Memo1: TMemo; + PayTimeGrp: TRadioGroup; + procedure ComputeBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + function PresentValue(Rate: Extended; NPeriods: Integer; Payment, FutureValue: + Extended; PaymentTime: TPaymentTime): Extended; + + private + { private declarations } + public + { public declarations } + end; + +var + PresentValueFrm: TPresentValueFrm; + +implementation + +{ TPresentValueFrm } + +procedure TPresentValueFrm.ResetBtnClick(Sender: TObject); +begin + FutureEdit.Text := ''; + PaymentEdit.Text := ''; + NPeriodsEdit.Text := ''; + RateEdit.Text := ''; + PresentEdit.Text := ''; +end; + +procedure TPresentValueFrm.FormShow(Sender: TObject); +begin + ResetBtnClick(self); +end; + +procedure TPresentValueFrm.ComputeBtnClick(Sender: TObject); +VAR + Rate, Payment, PresentVal, FutureVal, Interest : Extended; + NPeriods, When : integer; + Time : TPaymentTime; + +begin + If PayTimeGrp.ItemIndex = 0 then Time := ptStartofPeriod else + Time := ptEndofPeriod; + FutureVal := StrToFloat(FutureEdit.Text); + Rate := StrToFloat(RateEdit.Text); + NPeriods := StrToInt(NPeriodsEdit.Text); + Payment := StrToFloat(PaymentEdit.Text); + PresentVal := PresentValue(Rate, NPeriods, Payment, FutureVal, Time); + PresentEdit.Text := FloatToStr(PresentVal); + +end; + +function TPresentValueFrm.PresentValue(Rate: Extended; NPeriods: Integer; Payment, FutureValue: + Extended; PaymentTime: TPaymentTime): Extended; +var + Annuity, CompoundRN: Extended; +begin + if Rate <= -1.0 then ShowMessage('ERROR! PresentValue Rate <= -1.-'); + Annuity := Annuity2(Rate, NPeriods, PaymentTime, CompoundRN); + if CompoundRN > 1.0E16 then + PresentValue := -(Payment / Rate * Integer(PaymentTime) * Payment) + else + PresentValue := (-Payment * Annuity - FutureValue) / CompoundRN +end; + +initialization + {$I presentvalueunit.lrs} + +end. + diff --git a/applications/lazstats/source/not used by LazStats/typeunit.PAS b/applications/lazstats/source/not used by LazStats/typeunit.PAS new file mode 100644 index 000000000..b349ac4fe --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/typeunit.PAS @@ -0,0 +1,43 @@ +unit TypeUnit; + +{$MODE Delphi} + +interface + +uses + //Windows, Messages, + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls; + +type + TTypeFrm = class(TForm) + TypeRG: TRadioGroup; + CancelBtn: TButton; + OKBtn: TButton; + procedure CancelBtnClick(Sender: TObject); + procedure OKBtnClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + ItemType : integer; + end; + +var + TypeFrm: TTypeFrm; + +implementation + +{$R *.lfm} + +procedure TTypeFrm.CancelBtnClick(Sender: TObject); +begin + TypeFrm.Hide; +end; + +procedure TTypeFrm.OKBtnClick(Sender: TObject); +begin + TypeFrm.Hide; +end; + +end. diff --git a/applications/lazstats/source/not used by LazStats/typeunit.lfm b/applications/lazstats/source/not used by LazStats/typeunit.lfm new file mode 100644 index 000000000..ba1e95c46 --- /dev/null +++ b/applications/lazstats/source/not used by LazStats/typeunit.lfm @@ -0,0 +1,52 @@ +object TypeFrm: TTypeFrm + Left = 126 + Top = 120 + HelpContext = 1830 + BorderStyle = bsDialog + Caption = 'Item Type' + ClientHeight = 171 + ClientWidth = 185 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + HelpFile = 'ITEMBANKHELP.HLP' + PixelsPerInch = 96 + object TypeRG: TRadioGroup + Left = 8 + Top = 8 + Width = 169 + Height = 113 + Caption = 'Select the item type:' + ItemIndex = 0 + Items.Strings = ( + 'Multiple Choice' + 'True-False' + 'Set of Matching Items' + 'Essay' + 'Fill in the Blank/Completion') + TabOrder = 0 + end + object CancelBtn: TButton + Left = 8 + Top = 136 + Width = 73 + Height = 25 + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + OnClick = CancelBtnClick + end + object OKBtn: TButton + Left = 104 + Top = 136 + Width = 73 + Height = 25 + Caption = 'OK' + ModalResult = 1 + TabOrder = 2 + OnClick = OKBtnClick + end +end diff --git a/applications/lazstats/source/units/anovatestsunit.pas b/applications/lazstats/source/units/anovatestsunit.pas new file mode 100644 index 000000000..051b37a85 --- /dev/null +++ b/applications/lazstats/source/units/anovatestsunit.pas @@ -0,0 +1,689 @@ +// To do: +// - Remove overloads without AReport argument when OutFrm refactoring is done +// - Then remove dependence on OutputUnit. +// - Add parameter "Alpha" to remove dependence on BlkANOVAUnit + +unit ANOVATestsUnit; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + FunctionsLib, Globals, MainUnit, DataProcs; + +procedure Tukey( + error_ms : double; { mean squared for residual } + error_df : double; { deg. freedom for residual } + value : double; { size of smallest group } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { no. of cases in a group } + min_grp : integer; { minimum group code } + max_grp : integer; { maximum group code } + Alpha : Double; { alpha value } + AReport : TStrings); + +procedure ScheffeTest( + error_ms : double; { mean squared residual } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { count of cases in a group } + min_grp : integer; { code of first group } + max_grp : integer; { code of last group } + total_n : double; { total number of cases } + Alpha : double; { alpha value for testing } + AReport : TStrings); + +procedure Newman_Keuls( + error_ms : double; { residual mean squared } + error_df : double; { deg. freedom for error } + value : double; { number in smallest group } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { count of cases in a group } + min_grp : integer; { lowest group code } + max_grp : integer; { largest group code } + Alpha : double; { alpha value for testing } + AReport : TStrings); + +procedure Tukey_Kramer( + error_ms : double; { residual mean squared } + error_df : double; { deg. freedom for error } + value : double; { number in smallest group } + group_total : DblDyneVec; { sum of scores in group } + group_count : DblDyneVec; { number of caes in group } + min_grp : integer; { code of lowest group } + max_grp : integer; { code of highst group } + Alpha : double; { Alpha value for testing } + AReport : TStrings); + +procedure Contrasts( + error_ms : double; { residual ms } + error_df : double; { residual df } + group_total : DblDyneVec; { group sums } + group_count : DblDyneVec; { group cases } + min_grp : integer; { lowest code } + max_grp : integer; { highest code } + overall_probf : double; { prob of overall test } + AReport : TStrings); + +procedure Bonferroni( + group_total : DblDyneVec; { sum of scores in group } + group_count : DblDyneVec; { number of caes in group } + group_var : DblDyneVec; { group variances } + min_grp : integer; { code of lowest group } + max_grp : integer; { code of highst group } + Alpha : Double; { Alpha value for testing } + AReport : TStrings); + +procedure TukeyBTest( + ErrorMS : double; { within groups error } + ErrorDF : double; { degrees of freedom within } + group_total : DblDyneVec; { vector of group sums } + group_count : DblDyneVec; { vector of group n's } + min_grp : integer; { smallest group code } + max_grp : integer; { largest group code } + groupsize : double; { size of groups (all equal) } + Alpha : Double; { Alpha value for testing } + AReport : TStrings); + +procedure HomogeneityTest( + GroupCol : integer; + VarColumn : integer; + NoCases : integer); + + +implementation + +uses + OutputUnit, + BlkAnovaUnit; + +procedure Tukey(error_ms : double; { mean squared for residual } + error_df : double; { deg. freedom for residual } + value : double; { size of smallest group } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { no. of cases in a group } + min_grp : integer; { minimum group code } + max_grp : integer; { maximum group code } + Alpha : double; { alpha value } + AReport : TStrings); +var + sig: boolean; + divisor: double; + df1: integer; + contrast, mean1, mean2: double; + q_stat: double; + i,j: integer; + outline: string; +begin + AReport.Add('---------------------------------------------------------------'); + AReport.Add(' Tukey HSD Test for Differences Between Means'); + AReport.Add(' alpha selected = %.2f', [Alpha]); + AReport.Add('Groups Difference Statistic Probability Significant?'); + AReport.Add('---------------------------------------------------------------'); + + divisor := sqrt(error_ms / value ); + for i := min_grp to max_grp - 1 do + for j := i + 1 to max_grp do + begin + outline := format('%2d - %2d ',[i,j]); + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + contrast := mean1 - mean2; + outline := outline + format('%7.3f q = ',[contrast]); + contrast := abs(contrast / divisor) ; + outline := outline + format('%6.3f ',[contrast]); + df1 := max_grp - min_grp + 1; + q_stat := STUDENT(contrast,error_df,df1); + outline := outline + format(' %6.4f',[q_stat]); + + if alpha >= q_stat then + sig := TRUE + else + sig := FALSE; + + if sig = TRUE then + outline := outline + ' YES ' + else + outline := outline + ' NO'; + + AReport.Add(outline); + end; + + AReport.Add('---------------------------------------------------------------'); +end; + +procedure ScheffeTest(error_ms : double; { mean squared residual } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { count of cases in a group } + min_grp : integer; { code of first group } + max_grp : integer; { code of last group } + total_n : double; { total number of cases } + alpha : double; { alpha value for testing } + AReport : TStrings); +var + statistic, stat_var, stat_sd: double; + mean1, mean2, difference, prob_scheffe, f_prob, df1, df2: double; + outline: string; + i, j: integer; +begin + AReport.Add(''); + AReport.Add('----------------------------------------------------------------'); + AReport.Add(' Scheffe contrasts among pairs of means.'); + AReport.Add(' alpha selected = %.2f', [alpha]); + AReport.Add('Group vs Group Difference Scheffe Critical Significant?'); + AReport.Add(' Statistic Value'); + AReport.Add('----------------------------------------------------------------'); + + alpha := 1.0 - alpha ; + for i:= min_grp to max_grp - 1 do + for j := i + 1 to max_grp do + begin + outline := Format('%2d %2d ',[i,j]); + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + difference := mean1 - mean2; + outline := outline + Format('%8.2f ',[difference]); + stat_var := error_ms * (1.0 / group_count[i-1] + 1.0 / group_count[j-1]); + stat_sd := sqrt(stat_var); + statistic := abs(difference / stat_sd); + outline := outline + Format('%8.2f ',[statistic]); + df1 := max_grp - min_grp; + df2 := total_n - df1 + 1; + f_prob := fpercentpoint(alpha,round(df1),round(df2) ); + prob_scheffe := sqrt(df1 * f_prob); + outline := outline + Format('%8.3f ',[prob_scheffe]); + if statistic > prob_scheffe then + outline := outline + 'YES' + else + outline := outline + 'NO'; + AReport.Add(outline); + end; + + AReport.Add('----------------------------------------------------------------'); +end; + +{ ----------------------------------------------------------------------- } + +procedure Newman_Keuls(error_ms : double; { residual mean squared } + error_df : double; { deg. freedom for error } + value : double; { number in smallest group } + group_total : DblDyneVec; { sum of scores in a group } + group_count : DblDyneVec; { count of cases in a group } + min_grp : integer; { lowest group code } + max_grp : integer; { largest group code } + alpha : double; { alpha value for testing } + AReport : TStrings); +var + i, j : integer; + temp1, temp2 : double; + groupno : IntDyneVec; + contrast, mean1, mean2 : double; + q_stat : double; + divisor : double; + tempno : integer; + df1 : integer; + sig : boolean; + outline : string; +begin + SetLength(groupno,max_grp-min_grp+1); + for i := min_grp to max_grp do groupno[i-1] := i; + for i := min_grp to max_grp - 1 do + begin + for j := i + 1 to max_grp do + begin + if group_total[i-1] / group_count[i-1] > + group_total[j-1] / group_count[j-1] then + begin + temp1 := group_total[i-1]; + temp2 := group_count[i-1]; + tempno := groupno[i-1]; + group_total[i-1] := group_total[j-1]; + group_count[i-1] := group_count[j-1]; + groupno[i-1] := groupno[j-1]; + group_total[j-1] := temp1; + group_count[j-1] := temp2; + groupno[j-1] := tempno; + end; + end; + end; + + AReport.Add(''); + AReport.Add('----------------------------------------------------------------------'); + AReport.Add(' Neuman-Keuls Test for Contrasts on Ordered Means'); + AReport.Add(' alpha selected = %.2f', [alpha]); + AReport.Add(''); + AReport.Add('Group Mean'); + for i := 1 to max_grp do + AReport.Add('%3d %10.3f', [groupno[i-1], group_total[i-1] / group_count[i-1]]); + AReport.Add(''); + + AReport.Add('Groups Difference Statistic d.f. Probability Significant?'); + AReport.Add('----------------------------------------------------------------------'); + divisor := sqrt(error_ms / value); + for i := min_grp to max_grp - 1 do + begin + for j := i + 1 to max_grp do + begin + outline := Format('%2d - %2d ', [groupno[i-1], groupno[j-1]]); + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + contrast := mean1 - mean2; + outline := outline + Format('%7.3f q = ', [contrast]); + contrast := abs(contrast / divisor ); + df1 := j - i + 1; + outline := outline + Format('%6.3f %2d %3.0f ', [contrast, df1, error_df]); + q_stat := STUDENT(contrast, error_df, df1); + outline := outline + Format(' %6.4f', [q_stat]); + if alpha > q_stat then sig := TRUE else sig := FALSE; + if sig = TRUE then + outline := outline + ' YES' + else + outline := outline + ' NO'; + AReport.Add(outline); + end; + end; + AReport.Add('----------------------------------------------------------------------'); + groupno := nil; +end; + +{ ----------------------------------------------------------------------- } + +procedure Tukey_Kramer(error_ms : double; { residual mean squared } + error_df : double; { deg. freedom for error } + value : double; { number in smallest group } + group_total : DblDyneVec; { sum of scores in group } + group_count : DblDyneVec; { number of caes in group } + min_grp : integer; { code of lowest group } + max_grp : integer; { code of highst group } + Alpha : Double; { Alpha value for testing } + AReport : TStrings); +var + sig : boolean; + divisor : double; + df1 : integer; + contrast, mean1, mean2 : double; + q_stat : double; + outline : string; + i, j : integer; + +begin + AReport.Add(''); + AReport.Add('---------------------------------------------------------------'); + AReport.Add(' Tukey-Kramer Test for Differences Between Means'); + AReport.Add(' alpha selected = %.2f', [Alpha]); + AReport.Add('Groups Difference Statistic Probability Significant?'); + AReport.Add('---------------------------------------------------------------'); + + for i := min_grp to max_grp - 1 do + for j := i + 1 to max_grp do + begin + outline := format('%2d - %2d ',[i,j]); + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + contrast := mean1 - mean2; + outline := outline + format('%7.3f q = ',[contrast]); + divisor := sqrt(error_ms * ( ( 1.0/group_count[i-1] + 1.0/group_count[j-1] ) / 2 ) ); + contrast := abs(contrast / divisor) ; + outline := outline + format('%6.3f ',[contrast]); + df1 := max_grp - min_grp + 1; + q_stat := STUDENT(contrast,error_df,df1); + outline := outline + format(' %6.4f',[q_stat]); + if alpha >= q_stat then sig := TRUE else sig := FALSE; + if sig = TRUE then + outline := outline + ' YES ' + else + outline := outline + ' NO'; + AReport.Add(outline); + end; + AReport.Add('---------------------------------------------------------------'); +end; + +{ ------------------------------------------------------------------------ } + +procedure Contrasts(error_ms : double; { residual ms } + error_df : double; { residual df } + group_total : DblDyneVec; { group sums } + group_count : DblDyneVec; { group cases } + min_grp : integer; { lowest code } + max_grp : integer; { highest code } + overall_probf : double; { prob of overall test } + AReport : TStrings); +var + nocontrasts, i, j, k : integer; + df1, df2, probstat, statistic, alpha : double; + coefficients : array[1..20,1..20] of double; + nonorthog : boolean; + weight, sumcross : double; + response : string[5]; + outline : string; + prompt : string; + +begin + outline := format('Enter the number of contrasts (less than %2d or 0:',[max_grp-min_grp+1]); + response := InputBox('ORTHOGONAL CONTRASTS',outline,'0'); + nocontrasts := StrToInt(response); + + if nocontrasts > 0 then + begin + for i := 1 to nocontrasts do + begin + outline := format('Contrast number %2d',[i]); + for j := 1 to (max_grp - min_grp+1) do + begin + prompt := format('Group %2d coefficient = ',[j]); + response := InputBox(outline,prompt,'1'); + coefficients[i,j] := StrToFloat(response); + end; + end; + + { Check for orthogonality } + nonorthog := FALSE; + for i := 1 to nocontrasts - 1 do + begin + for j := i + 1 to nocontrasts do + begin + sumcross := 0; + for k := 1 to (max_grp - min_grp + 1) do + begin + sumcross := sumcross + coefficients[i,k]*coefficients[j,k]; + end; + if sumcross <> 0 then nonorthog := TRUE; + if sumcross <> 0 then + begin + MessageDlg(Format('Contrasts %2d and %2d not orthogonal.',[i,j]), mtError, [mbOK], 0);; + end; + end; + end; + + if not nonorthog then + begin + alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text); + if overall_probf > alpha then + begin + AReport.Add('No contrasts significant.'); + exit; + end; + + AReport.Add(''); + AReport.Add('---------------------------------------------------------------'); + AReport.Add(' ORTHOGONAL CONTRASTS'); + AReport.Add('Contrast Statistic Probability Critical Value Significant?'); + AReport.Add('---------------------------------------------------------------'); + + for i := 1 to nocontrasts do + begin + statistic := 0.0; + weight := 0.0; + for j := 1 to (max_grp - min_grp + 1) do + begin + statistic := statistic + (coefficients[i,j] * (group_total[j-1] / group_count[j-1])); + weight := weight + (sqr(coefficients[i,j]) / group_count[j-1]); + end; + statistic := sqr(statistic); + statistic := statistic / (error_ms * weight); + outline := Format('%3d %9.4f ', [i, statistic]); + df1 := 1; + df2 := error_df; + probstat := probf(statistic,round(df1),round(df2)) / 2; + outline := outline + Format('%8.3f %5.2f ', [probstat, alpha]); + if probstat < alpha then + outline := outline + 'YES' + else + outline := outline + 'NO'; + AReport.Add(outline); + end; + AReport.Add(''); + AReport.Add('Contrast Coefficients Used:'); + for i := 1 to nocontrasts do + begin + outline := format('Contrast %2d ',[i]); + for j := 1 to (max_grp - min_grp + 1) do + outline := outline + format('%4.1f ',[coefficients[i,j]]); + AReport.Add(outline); + end; + end; { if orthogonal } + AReport.Add('---------------------------------------------------------------'); + end; { if nocontrasts > 0 } +end; { of procedure CONTRASTS } + + +procedure Bonferroni( group_total : DblDyneVec; { sum of scores in group } + group_count : DblDyneVec; { number of cases in group } + group_var : DblDyneVec; { group variances } + min_grp : integer; { code of lowest group } + max_grp : integer; { code of highst group } + Alpha : double; { Alpha value for testing } + AReport : TStrings); +var + i, j : integer; + contrast, mean1, mean2 : double; + divisor : double; + df2 : integer; + testalpha : double; + NoGrps : integer; + tprob : double; + sig : string[6]; + SS1, SS2 : double; +begin + AReport.Add(''); + AReport.Add('---------------------------------------------------------------'); + AReport.Add(' Bonferroni Test for Differences Between Means'); + AReport.Add(' Overall alpha selected = %.2f', [alpha]); + AReport.Add('---------------------------------------------------------------'); + + NoGrps := max_grp - min_grp + 1; + testalpha := alpha / ( (NoGrps * (NoGrps-1)) / 2.0 ); + AReport.Add('Comparisons made at alpha / no. comparisons = %5.3f', [testalpha]); + AReport.Add(''); + AReport.Add('Groups Difference Statistic Prob > Value Significant?'); + for i := 1 to NoGrps - 1 do + begin + for j := i+1 to NoGrps do + begin + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + SS1 := group_var[i-1] * (group_count[i-1] - 1.0); + SS2 := group_var[j-1] * (group_count[j-1] - 1.0); + divisor := (SS1 + SS2) / (group_count[i-1] + group_count[j-1] - 2.0); + divisor := sqrt(divisor * ( 1.0 / group_count[i-1] + 1.0 / group_count[j-1])); + contrast := abs(mean1-mean2) / divisor; + df2 := round(group_count[i-1] + group_count[j-1] - 2.0); + tprob := probt(contrast,df2); + if testalpha >= tprob then sig := 'YES' else sig := 'NO'; + AReport.Add('%3d - %3d %10.3f %10.3f %10.3f %s', [ + min_grp+i-1, min_grp+j-1, mean1-mean2, contrast, tprob, sig + ]); + end; + end; +end; +//------------------------------------------------------------------- + +procedure TukeyBTest(ErrorMS : double; { within groups error } + ErrorDF : double; { degrees of freedom within } + group_total : DblDyneVec; { vector of group sums } + group_count : DblDyneVec; { vector of group n's } + min_grp : integer; { smallest group code } + max_grp : integer; { largest group code } + groupsize : double; { size of groups (all equal) } + Alpha : double; { Alpha value for testing } + AReport : TStrings); +var + i, j: integer; + df1: double; + qstat: double; + tstat: double; + groupno: IntDyneVec; + temp1, temp2: double; + tempno: integer; + NoGrps: integer; + contrast: double; + mean1, mean2: double; + sig: string[6]; + groups: double; + divisor: double; + +begin + SetLength(groupno,max_grp-min_grp+1); + + AReport.Add(''); + AReport.Add('---------------------------------------------------------------'); + AReport.Add(' Tukey B Test for Contrasts on Ordered Means'); + AReport.Add(' alpha selected = %.2f',[alpha]); + AReport.Add('---------------------------------------------------------------'); + AReport.Add(''); + AReport.Add('Groups Difference Statistic d.f. Prob.>value Significant?'); + + divisor := sqrt(ErrorMS / groupsize); + NoGrps := max_grp - min_grp + 1; + for i := min_grp to max_grp do groupno[i-1] := i; + for i := 1 to NoGrps - 1 do + begin + for j := i + 1 to NoGrps do + begin + if group_total[i-1] / group_count[i-1] > group_total[j-1] / group_count[j-1] then + begin + temp1 := group_total[i-1]; + temp2 := group_count[i-1]; + tempno := groupno[i-1]; + group_total[i-1] := group_total[j-1]; + group_count[i-1] := group_count[j-1]; + groupno[i-1] := groupno[j-1]; + group_total[j-1] := temp1; + group_count[j-1] := temp2; + groupno[j-1] := tempno; + end; + end; + end; + + for i := 1 to NoGrps-1 do + begin + for j := i+1 to NoGrps do + begin + mean1 := group_total[i-1] / group_count[i-1]; + mean2 := group_total[j-1] / group_count[j-1]; + contrast := abs((mean1 - mean2) / divisor); + df1 := j - i + 1.0; + qstat := STUDENT(contrast,ErrorDF,df1); + groups := NoGrps; + tstat := STUDENT(contrast,ErrorDF,groups); + qstat := (qstat + tstat) / 2.0; + if alpha >= qstat then sig := 'YES' else sig := 'NO'; + AReport.Add('%3d - %3d %10.3f %10.3f %4.0f,%4.0f %5.3f %s', [ + groupno[i-1], groupno[j-1], mean1-mean2, contrast, df1, ErrorDF, qstat, sig + ]); + end; + end; + + groupno := nil; +end; + +procedure HomogeneityTest(GroupCol : integer; + VarColumn : integer; + NoCases : integer); +Var + i, j, k, N, intvalue, Nf1cells: integer; + min, max : integer; + zscores : DblDyneMat; + medians : DblDyneVec; + cellcnts : IntDyneVec; + cellvars : DblDyneVec; + cellsums : DblDyneVec; + X, X2, temp : double; + outline : string; +begin + // complete a one-way anova on z scores obtained as the absolute difference + // between between the observed score and the median of a group. + + // get min and max group codes + min := 100000; + max := 0; + N := 0; + + for i := 1 to NoCases do + begin + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GroupCol,i]))); + if intvalue < min then min := intvalue; + if intvalue > max then max := intvalue; + end; + Nf1cells := max - min + 1; + + setlength(zscores,Nf1cells,NoCases); + setlength(medians,Nf1cells); + setlength(cellcnts,Nf1cells); + setlength(cellvars,Nf1cells); + setlength(cellsums,Nf1cells); + + // Get cell counts + for i := 1 to NoCases do + begin + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GroupCol,i]))); + intvalue := intvalue - min + 1; + cellcnts[intvalue-1] := cellcnts[intvalue-1] + 1; + end; + + // get working totals + for j := 0 to Nf1cells do + begin + k := 0; + for i := 1 to NoCases do + begin + if not ValidValue(i,VarColumn) then continue; + intvalue := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GroupCol,i]))); + intvalue := intvalue - min; + if intvalue <> j then continue; + X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[VarColumn,i])); + zscores[intvalue,k] := X; + k := k + 1; + end; + end; + + //sort on z scores and obtain the median for each group + for i := 0 to Nf1cells-1 do // sort scores in each group + begin + for j := 0 to cellcnts[i]-2 do + begin + for k := j+1 to cellcnts[i]-1 do + begin + X := zscores[i,j]; + X2 := zscores[i,k]; + if X2 < X then // swap + begin + temp := X; + X := X2; + X2 := temp; + end; + end; + end; + end; + + for i := 0 to Nf1cells-1 do + begin + medians[i] := zscores[i,cellcnts[i] div 2]; + end; + + // Get deviations from the medians + for i := 0 to Nf1cells-1 do + begin + for j := 0 to cellcnts[i]-1 do + zscores[i,j] := zscores[i,j] - medians[i]; + end; + + // place group membership and z deviation scores in columns and + // do a regular one-way ANOVA + k := 0; + for i := 0 to Nf1cells-1 do + begin + for j := 0 to cellcnts[i]-1 do + begin + k := k +1; + OS3MainFrm.DataGrid.Cells[GroupCol,k] := IntToStr(i+1); + OS3MainFrm.DataGrid.Cells[VarColumn,k] := FloatToStr(abs(zscores[i,j])); + end; + end; + outline := 'Data have been placed in the grid. Do a one-way ANOVA'; + ShowMessage(outline); +end; + +end. + diff --git a/applications/lazstats/source/units/dataprocs.pas b/applications/lazstats/source/units/dataprocs.pas new file mode 100644 index 000000000..76809d19b --- /dev/null +++ b/applications/lazstats/source/units/dataprocs.pas @@ -0,0 +1,1771 @@ +unit DataProcs; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, Clipbrd, + Globals, OptionsUnit, DictionaryUnit, OutputUnit; + +Function GoodRecord(Row, NoVars : integer; VAR GridPos : IntDyneVec): boolean; +procedure FormatCell(Col, Row : integer); +procedure FormatGrid; +function IsNumeric(s : string) : boolean; +procedure VecPrint(vector : IntDyneVec; Size : integer; Heading : string); +procedure SaveOS2File; +procedure OpenOS2File; +procedure OpenOS2File(const AFileName: String; ShowDictionaryForm: Boolean); +procedure DeleteCol; +procedure CopyColumn; +procedure PasteColumn; +procedure InsertCol; +procedure InsertRow; +procedure CutaRow; +procedure CopyaRow; +procedure PasteaRow; +procedure PrintDict; +procedure PrintData; +procedure OpenTabFile; +procedure SaveTabFile; +function ValidValue(row, col : integer) : boolean; +function IsFiltered(GridRow : integer) : boolean; +procedure MATREAD(VAR a : DblDyneMat; + VAR norows : integer; + VAR nocols : integer; + VAR means : DblDyneVec; + VAR stddevs : DblDyneVec; + VAR NCases : integer; + VAR RowLabels : StrDyneVec; + VAR ColLabels : StrDyneVec; + filename : string); +procedure MATSAVE(VAR a : DblDyneMat; + norows : integer; + nocols : integer; + VAR means : DblDyneVec; + VAR stddevs : DblDyneVec; + NCases : integer; + VAR RowLabels : StrDyneVec; + VAR ColLabels : StrDyneVec; + filename : string); +procedure ReOpen(filename : string); +procedure OpenCommaFile; +procedure SaveCommaFile; +procedure OpenSpaceFile; +procedure SaveSpaceFile; +procedure OpenOSData; +procedure ClearGrid; +procedure CopyIt; +procedure PasteIt; +procedure RowColSwap; +procedure MatToGrid(VAR mat : DblDyneMat; nsize : integer); +procedure GetTypes; +function StringsToInt(strcol : integer; VAR newcol : integer; prompt : boolean) : boolean; + + +implementation + +uses MainUnit; + +Function GoodRecord(Row, NoVars : integer; VAR GridPos : IntDyneVec): boolean; +var + i, j : integer; + isgood : boolean; + +begin + isgood := true; + for i := 1 to NoVars do + begin + j := GridPos[i-1]; + if NOT ValidValue(Row,j) then isgood := false; + end; + Result := isgood; +end; +//------------------------------------------------------------------- + +procedure FormatCell(Col, Row : integer); +var + VarType : char; + NoDec : integer; + Justify : char; + missing : string; + astr : string; + cellstr : string; + newcell : string; + X : double; + Width : integer; + cellsize : integer; + I: Integer; + +begin + if OS3MainFrm.DataGrid.Cells[Col,Row] = '' then + exit; + + Width := StrToInt(DictionaryFrm.DictGrid.Cells[3,Col]); + + astr := DictionaryFrm.DictGrid.Cells[4,Col]; + if astr <> '' then VarType := astr[1] else VarType := 'F'; + + NoDec := StrToInt(DictionaryFrm.DictGrid.Cells[5,Col]); + + astr := DictionaryFrm.DictGrid.Cells[7,Col]; + if astr <> '' then Justify := astr[1] else Justify := 'L'; + + missing := DictionaryFrm.DictGrid.Cells[6,Col]; + cellstr := Trim(OS3MainFrm.DataGrid.Cells[Col,Row]); + if missing = cellstr then + exit; + + if (VarType = 'F') and TryStrToFloat(cellStr, X) then + newcell := FloatToStrF(X, ffFixed, Width, NoDec) + else + if (VarType = 'I') and TryStrToInt(cellStr, I) then + newCell := IntToStr(I) + (* + if (VarTyp + if ((VarType = 'F') or (VarType = 'I')) then + begin + if TryStrToFloat(cellstr, X) then + newcell := FloatToStrF(X, ffFixed, Width, NoDec); + { + if IsNumeric(cellstr) then + begin + X := StrToFloat(cellstr); + newcell := FloatToStrF(X,ffFixed,Width,NoDec); +// Str(X:Width:NoDec,newcell); + end; + + } + end + *) + else + newcell := cellstr; + + // now set justification + cellsize := OS3MainFrm.DataGrid.ColWidths[Col]; // in pixels + cellsize := cellsize div 8; + case Justify of + 'L' : newcell := TrimLeft(newcell); + 'C' : begin + newcell := Trim(newcell); + while Length(newcell) < cellsize do + newcell := ' ' + newcell + ' '; + end; + 'R' : begin + newcell := Trim(newcell); + while Length(newcell) < cellsize do newcell := ' ' + newcell; + end; + end; + OS3MainFrm.DataGrid.Cells[Col,Row] := newcell; +end; +//------------------------------------------------------------------- + +procedure FormatGrid; +var + i, j : integer; + +begin + for i := 1 to NoCases do + for j := 1 to NoVariables do FormatCell(j,i); +end; +//------------------------------------------------------------------- + +function IsNumeric(s : string) : boolean; +var + i, strlong: integer; + isnumber: boolean; +begin + (* + Assert(OptionsFrm <> nil); + + if OptionsFrm.FractionTypeGrp.ItemIndex = 0 then + begin + FractionType := 0; + DecimalSeparator := '.' + end + else begin + FractionType := 1; + DecimalSeparator := ','; + end; + *) + + isnumber := true; + strlong := length(s); + for i := 1 to strlong do + // if (not(((s[i] >= '0') and (s[i] <= '9')) or (s[i] = DecimalSeparator) or + // (s[i] = '-'))) then isnumber := false; + if (ord(s[i]) < 44) or (ord(s[i]) > 57 ) or (ord(s[i]) = 47) then + isnumber := false; + result := isnumber; +end; +//----------------------------------------------------------------------------- + +procedure VecPrint(vector : IntDyneVec; Size : integer; Heading : string); +var + i, start, last : integer; + nvals : integer; + done : boolean; + astr : string; + +begin + nvals := 8; + done := false; + OutPutFrm.RichEdit.Lines.Add(''); + OutPutFrm.RichEdit.Lines.Add(Heading); + OutPutFrm.RichEdit.Lines.Add(''); + start := 1; + last := nvals; + if last > Size then last := Size; + while not done do + begin + astr := ''; + for i := start to last do + astr := astr + format('%8d ',[i]); + OutPutFrm.RichEdit.Lines.Add(astr); + astr := ''; + for i := start to last do + astr := astr + format('%8d ',[vector[i-1]]); + OutPutFrm.RichEdit.Lines.Add(astr); + if last < Size then + begin + OutPutFrm.RichEdit.Lines.Add(''); + start := last + 1; + last := start + nvals - 1; + if last > Size then last := Size; + end + else done := true; + end; +end; +//------------------------------------------------------------------- +procedure SaveOS2File; +var + F: TextFile; + filename: string; + s: string; + NRows, NCols: integer; + i, j: integer; +begin + // check for valid cases - at least one value entered + NRows := StrToInt(OS3MainFrm.NoCasesEdit.Text); + NCols := StrToInt(OS3MainFrm.NoVarsEdit.Text); + if (NRows = 0) or (NCols = 0) then + begin + MessageDlg('No data to save.', mtError, [mbOK], 0); + exit; + end; + + filename := ChangeFileExt(OS3MainFrm.FileNameEdit.Text, '.laz'); + OS3MainFrm.SaveDialog1.InitialDir := ExtractFileDir(filename); + OS3MainFrm.SaveDialog1.FileName := ExtractFileName(filename); + OS3MainFrm.SaveDialog1.DefaultExt := '.laz'; +// OS3MainFrm.SaveDialog1.Filter := 'LazStats (*.laz)|*.laz;*.LAZ|Tab (*.tab)|*.tab;*.TAB|space (*.spc)|*.spc;*.SPC'; + OS3MainFrm.SaveDialog1.Filter := 'LazStats (*.laz)|*.laz;*.LAZ|All files (*.*)|*.*'; + OS3MainFrm.SaveDialog1.FilterIndex := 1; + if OS3MainFrm.SaveDialog1.Execute then + begin + filename := ExpandFileName(OS3MainFrm.SaveDialog1.FileName); + OS3MainFrm.FileNameEdit.Text := filename; + AssignFile(F, filename); + Rewrite(F); + + Writeln(F, NRows); + Writeln(F, NCols); + + // write dictionary information for file first + for i := 1 to NCols do + begin + for j := 1 to 7 do + begin + s := DictionaryFrm.DictGrid.Cells[j, i]; + Writeln(F, s); + end; + end; +{ MemLines := DictionaryFrm.DescMemo.Lines.Count; + Writeln(F,MemLines); + for i := 0 to MemLines - 1 do + Writeln(F,DictionaryFrm.DescMemo.Lines[i]); } + + // now save grid cell values, incl col and row headers. + for i := 0 to NRows do + begin + for j := 0 to NCols do + begin + s := OS3MainFrm.DataGrid.Cells[j, i]; + Writeln(F, s); + end; + end; + CloseFile(F); + end; +end; +//------------------------------------------------------------------- + +procedure OpenOS2File; +begin + OS3MainFrm.OpenDialog1.DefaultExt := '.laz'; + OS3MainFrm.OpenDialog1.Filter := 'LazStats (*.laz)|*.laz;*.LAZ|All files (*.*)|*.*'; + OS3MainFrm.OpenDialog1.FilterIndex := 1; + if OS3MainFrm.OpenDialog1.Execute then + OpenOS2File(OS3MainFrm.OpenDialog1.FileName, true); +end; + +procedure OpenOS2File(const AFileName: String; ShowDictionaryForm: Boolean); +var + F: TextFile; + s: string; + i, j: integer; + NRows, NCols: integer; +begin + DictLoaded := false; + + OS3MainFrm.FileNameEdit.Text := ExpandFileName(AFileName); + if not FileExists(OS3MainFrm.FileNameEdit.Text) then begin + MessageDlg(Format('File "%s" not found.', [AFileName]), mtError, [mbOK], 0); + exit; + end; + + AssignFile(F, AFileName); + Reset(F); + ReadLn(F, NRows); + ReadLn(F, NCols); + + // initialize the dictionary grid for NCols of variables + // using the default formats (protective measure in case of + // a screw-up where the dictionary was damaged + DictionaryFrm.DictGrid.ColCount := 8; + DictionaryFrm.DictGrid.RowCount := NCols + 1; + for i := 1 to NCols do + begin + DictionaryFrm.DictGrid.Cells[0, i] := IntToStr(i); + DictionaryFrm.DictGrid.Cells[1, i] := 'VAR.' + IntToStr(i); + DictionaryFrm.DictGrid.Cells[2, i] := 'VARIABLE ' + IntToStr(i); + DictionaryFrm.DictGrid.Cells[3, i] := '8'; + DictionaryFrm.DictGrid.Cells[4, i] := 'F'; + DictionaryFrm.DictGrid.Cells[5, i] := '2'; + DictionaryFrm.DictGrid.Cells[6, i] := ' '; + DictionaryFrm.DictGrid.Cells[7, i] := 'L'; + end; + + // get dictionary info first + for i := 1 to NCols do + begin + for j := 1 to 7 do + begin + Readln(F, s); + DictionaryFrm.DictGrid.Cells[j,i] := s; + end; + VarDefined[i] := true; + end; + DictLoaded := true; + +{ Readln(F, s); + MemLines := StrToInt(s); + DictionaryFrm.DescMemo.Clear; + for i := 0 to MemLines - 1 do + begin + readln(F, s); + DictionaryFrm.DescMemo.Lines.Add(s); + end; } + + // Now read grid data + OS3MainFrm.DataGrid.RowCount := NRows + 1; + OS3MainFrm.DataGrid.ColCount := NCols + 1; + OS3MainFrm.NoCasesEdit.Text := IntToStr(NRows); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NCols); + NoVariables := NCols; + NoCases := NRows; + for i := 0 to NRows do + begin + for j := 0 to NCols do + begin + ReadLn(F, s); + OS3MainFrm.DataGrid.Cells[j,i] := s; + end; + end; + CloseFile(F); + + // copy column names into the data dictionary. Note, this is + // redundant with the saved dictionary but helps restore in case + // of a screw-up + for i := 1 to NCols do + DictionaryFrm.DictGrid.Cells[1,i] := OS3MainFrm.DataGrid.Cells[i,0]; + for i := 1 to NRows do + OS3MainFrm.DataGrid.Cells[0,i] := 'CASE ' + IntToStr(i); + if ShowDictionaryForm then + DictionaryFrm.ShowModal; + FormatGrid; +end; +//------------------------------------------------------------------- + +procedure DeleteCol; +var + i, j, col: integer; + buf : pchar; +begin + col := OS3MainFrm.DataGrid.Col; + NoVariables := StrToInt(OS3MainFrm.NoVarsEdit.Text); +// TempStream.Clear; +// OS3MainFrm.DataGrid.Cols[col].SaveToStream(TempStream); + buf := OS3MainFrm.DataGrid.Cols[col].GetText; + ClipBoard.SetTextBuf(buf); + if col = NoVariables then // last column + begin + for j := 0 to NoCases do OS3MainFrm.DataGrid.Cells[col,j] := ''; + VarDefined[col] := false; + end + else // must be a variable in front of another variable + begin + for i := col + 1 to NoVariables do //Grid.ColCount - 1 do + for j := 0 to NoCases do //Grid.RowCount - 1 do + OS3MainFrm.DataGrid.Cells[i-1,j] := OS3MainFrm.DataGrid.Cells[i,j]; + for j := 0 to OS3MainFrm.DataGrid.RowCount - 1 do + OS3MainFrm.DataGrid.Cells[NoVariables,j] := ''; + end; + varDefined[NoVariables] := false; + OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount - 1; + NoVariables := NoVariables - 1; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + // update dictionary + DictionaryFrm.DelRow(col); +end; +//------------------------------------------------------------------- + +procedure CopyColumn; +var + col: integer; + buf : pchar; +begin + col := OS3MainFrm.DataGrid.Col; + buf := OS3MainFrm.DataGrid.Cols[col].GetText; + ClipBoard.SetTextBuf(buf); +// The following code can be used instead of the above if no clipboard available +// TempStream.Clear; +// OS3MainFrm.DataGrid.Cols[col].SaveToStream(TempStream); +// DictionaryFrm.CopyVar(col); +end; +//------------------------------------------------------------------- + +procedure InsertCol; +var + i, j, col: integer; +begin + // insert a new, blank column into the data grid + col := OS3MainFrm.DataGrid.Col; +// DictionaryFrm.NewVar(col); + NoVariables := NoVariables + 1; + OS3MainFrm.DataGrid.ColCount := NoVariables + 1; + for i := NoVariables downto col do { move to right } + begin + for j := 0 to NoCases do + begin + OS3MainFrm.DataGrid.Cells[i,j] := OS3MainFrm.DataGrid.Cells[i-1,j]; + end; + end; + NoVariables := NoVariables - 1; + DictionaryFrm.NewVar(col); + for i := 1 to NoCases do OS3MainFrm.DataGrid.Cells[col,i] := ''; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); +end; +//------------------------------------------------------------------- + +procedure PasteColumn; +var + col, i, j : integer; + buf : pchar; + size : integer; + strarray : array[0..100000] of char; + +begin + col := OS3MainFrm.DataGrid.Col; + NoVariables := OS3MainFrm.DataGrid.ColCount-1; + NoCases := OS3MainFrm.DataGrid.RowCount - 1; + if col <= NoVariables then + begin // add a blank column, move current over and update dictionary + OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 1; + for i := NoVariables downto col do + for j := 0 to NoCases do + OS3MainFrm.DataGrid.Cells[i+1,j] := OS3MainFrm.DataGrid.Cells[i,j]; + DictionaryFrm.NewVar(col); + VarDefined[col] := true; + OS3MainFrm.ColEdit.Text := IntToStr(OS3MainFrm.DataGrid.ColCount-1); +// NoVariables := NoVariables + 1; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + end; + buf := strarray; + size := 100000; + ClipBoard.GetTextBuf(buf,size); + OS3MainFrm.DataGrid.Cols[col].SetText(buf); +end; +//------------------------------------------------------------------- + +procedure CutaRow; +var + row, i, j : integer; + buf : pchar; + +begin + row := OS3MainFrm.DataGrid.Row; + buf := OS3MainFrm.DataGrid.Rows[row].GetText; + ClipBoard.SetTextBuf(buf); +// TempStream.Clear; +// OS3MainFrm.DataGrid.Rows[row].SaveToStream(TempStream); + for i := 1 to NoVariables do OS3MainFrm.DataGrid.Cells[i,row] := ''; + if row < NoCases then + begin // move rows below up 1 + for i := row + 1 to NoCases do + for j := 1 to NoVariables do OS3MainFrm.DataGrid.Cells[j,i-1] := OS3MainFrm.DataGrid.Cells[j,i]; + for j := 1 to NoVariables do OS3MainFrm.DataGrid.Cells[j,NoCases] := ''; + end; + OS3MainFrm.DataGrid.RowCount := OS3MainFrm.DataGrid.RowCount - 1; + OS3MainFrm.RowEdit.Text := IntToStr(OS3MainFrm.DataGrid.RowCount-1); + NoCases := NoCases - 1; + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases); + // renumber cases + for i := 1 to NoCases do OS3MainFrm.DataGrid.Cells[0,i] := 'CASE ' + IntToStr(i); +end; +//------------------------------------------------------------------- + +procedure CopyaRow; +var + row : integer; + buf : pchar; + +begin + row := OS3MainFrm.DataGrid.Row; + buf := OS3MainFrm.DataGrid.Rows[row].GetText; + ClipBoard.SetTextBuf(buf); +// TempStream.Clear; +// OS3MainFrm.DataGrid.Rows[row].SaveToStream(TempStream); +end; +//------------------------------------------------------------------- + +procedure PasteaRow; +var + row, i, j : integer; + buf : pchar; + strarray : array[0..100000] of char; + size : integer; + +begin + row := OS3MainFrm.DataGrid.Row; + OS3MainFrm.DataGrid.RowCount := OS3MainFrm.DataGrid.RowCount + 1; + OS3MainFrm.RowEdit.Text := IntToStr(OS3MainFrm.DataGrid.RowCount-1); + if row <= NoCases then // move all down before inserting + begin + for i := NoCases downto row do + for j := 1 to NoVariables do + OS3MainFrm.DataGrid.Cells[j,i+1] := OS3MainFrm.DataGrid.Cells[j,i]; + end; + OS3MainFrm.DataGrid.Row := row; + buf := strarray; + size := 100000; + ClipBoard.GetTextBuf(buf,size); + OS3MainFrm.DataGrid.Rows[row].SetText(buf); +// Use the following instead of the previous 4 if clipboard is unavailable +// TempStream.Position := 0; +// OS3MainFrm.DataGrid.Rows[row].LoadFromStream(TempStream); + NoCases := NoCases + 1; + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases); + // renumber cases + for i := 1 to NoCases do OS3MainFrm.DataGrid.Cells[0,i] := 'CASE ' + IntToStr(i); + +end; +//------------------------------------------------------------------- + +procedure PrintDict; +var + outline: string; + i : integer; + +begin + OutputFrm.RichEdit.Clear; + OutputFrm.RichEdit.Alignment := taLeftJustify; + outline := OS3MainFrm.FileNameEdit.Text + ' VARIABLE DICTIONARY'; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + for i:= 0 to NoVariables do + begin + outline := ''; + outline := outline + '| ' + format('%9s',[DictionaryFrm.DictGrid.Cells[0,i]]); + outline := outline + ' | ' + format('%10s',[DictionaryFrm.DictGrid.Cells[1,i]]); + outline := outline + ' | ' + format('%15s',[DictionaryFrm.DictGrid.Cells[2,i]]); + outline := outline + ' | ' + format('%6s',[DictionaryFrm.DictGrid.Cells[3,i]]); + outline := outline + ' | ' + format('%6s',[DictionaryFrm.DictGrid.Cells[4,i]]); + outline := outline + ' | ' + format('%8s',[DictionaryFrm.DictGrid.Cells[5,i]]); + outline := outline + ' | ' + format('%7s',[DictionaryFrm.DictGrid.Cells[6,i]]); + outline := outline + ' | ' + format('%6s',[DictionaryFrm.DictGrid.Cells[7,i]]); + OutPutFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; +end; +//------------------------------------------------------------------- + +procedure PrintData; +var + outline: string; + startcol: integer; + endcol: integer; + done: boolean; + cellstring: string; + i, j: integer; + +begin + OutPutFrm.RichEdit.Clear; + OutPutFrm.RichEdit.Alignment := taLeftJustify; + outline := OS3MainFrm.FileNameEdit.Text; + OutPutFrm.RichEdit.Lines.Add(outline); + outline := IntToStr(NoCases); + outline := 'No. of Cases = ' + outline; + outline := outline + ', No. of Variables = '; + outline := outline + IntToStr(NoVariables); + OutPutFrm.RichEdit.Lines.Add(outline); + OutPutFrm.RichEdit.Lines.Add(''); + done := false; + startcol := 1; + while done = false do + begin + endcol := startcol + 7; + if endcol > NoVariables then endcol := NoVariables; + for i:= 0 to NoCases do + begin + outline := ''; + outline := format('%10s',[Trim(OS3MainFrm.DataGrid.Cells[0,i])]); + for j := startcol to endcol do + begin + cellstring := format('%10s',[Trim(OS3MainFrm.DataGrid.Cells[j,i])]); + outline := outline + cellstring; + end; + OutPutFrm.RichEdit.Lines.Add(outline); + end; + if endcol = NoVariables then done := true else + begin + startcol := endcol+1; + OutPutFrm.RichEdit.Lines.Add(''); + end; + end; + OutPutFrm.ShowModal; +end; +//------------------------------------------------------------------- + +procedure OpenTabFile; +var + TabFile : TextFile; + namestr : string; + s: string; + ch: char; + labelsinc : boolean; + row, col : integer; + res: TModalResult; +begin + Assert(OS3MainFrm <> nil); + Assert(OptionsFrm <> nil); + + labelsinc := false; + + // check for a currently open file + if NoVariables > 1 then + begin + MessageDlg('Close (or Save and Close) the current work.', mtWarning, [mbOK], 0); + exit; + end; + + OS3MainFrm.OpenDialog1.Filter := 'Tab field files (*.tab)|*.tab;*.TAB|Text files (*.txt)|*.txt;*.TXT|All files (*.*)|*.*'; + OS3MainFrm.OpenDialog1.FilterIndex := 1; + OS3MainFrm.OpenDialog1.DefaultExt := 'tab'; + if OS3MainFrm.OpenDialog1.Execute then + begin + res := MessageDlg('Are variable labels included?', mtConfirmation, [mbYes, mbNo, mbCancel], 0); + if res = mrCancel then + exit; + labelsInc := (res = mrYes); + NoCases := 0; + NoVariables := 0; + if labelsinc = true then row := 0 else row := 1; + col := 1; + AssignFile(TabFile, OS3MainFrm.OpenDialog1.FileName); { File selected in dialog box } + Reset(tabfile); + OS3MainFrm.FileNameEdit.Text := OS3MainFrm.OpenDialog1.FileName; + s := ''; + while not EOF(TabFile) do + begin + Read(TabFile, ch); + if (ch < #9) or (ch > #127) then + Continue; + if (ch = #13) then + Continue; // line feed character + if (ch <> #9) and (ch <> #10) then // check for tab or new line + s := s + ch + else if ch = #9 then // tab character found + begin + if (not labelsinc) and (row = 1) then // create a col. label + begin + namestr := 'VAR ' + IntToStr(col); + OS3MainFrm.DataGrid.Cells[col,0] := namestr; + end; + OS3MainFrm.DataGrid.Cells[col,row] := s; + if col > NoVariables then + begin + NoVariables := col; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + end; + col := col + 1; + s := ''; + if col >= OS3MainFrm.DataGrid.ColCount then + OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 1; + end + else //must be new line character + begin + if (not labelsinc) and (row = 1) then // create a col. label + begin + namestr := 'VAR ' + IntToStr(col); + OS3MainFrm.DataGrid.Cells[col,0] := namestr; + end; + OS3MainFrm.DataGrid.Cells[col,row] := s; + s := ''; + if col > NoVariables then + begin + NoVariables := col; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + end; + col := 1; + if row > NoCases then NoCases := row; + OS3MainFrm.DataGrid.Cells[0,row] := 'Case ' + IntToStr(row); + row := row + 1; + if row >= OS3MainFrm.DataGrid.RowCount then + OS3MainFrm.DataGrid.RowCount := OS3MainFrm.DataGrid.RowCount + 1; + end; + end; // END OF FILE + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + CloseFile(TabFile); + if NoVariables >= OS3MainFrm.DataGrid.ColCount - 1 then + OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 1; + // set up the dictionary + DictionaryFrm.DictGrid.RowCount := NoVariables + 1; + DictionaryFrm.DictGrid.ColCount := 8; + for row := 1 to NoVariables do + begin + DictionaryFrm.DictGrid.Cells[0,row] := IntToStr(row); + DictionaryFrm.DictGrid.Cells[1,row] := 'VAR.' + IntToStr(row); + DictionaryFrm.DictGrid.Cells[2,row] := 'VARIABLE ' + IntToStr(row); + DictionaryFrm.DictGrid.Cells[3,row] := '8'; + DictionaryFrm.DictGrid.Cells[4,row] := 'F'; + DictionaryFrm.DictGrid.Cells[5,row] := '2'; + DictionaryFrm.DictGrid.Cells[6,row] := MissingValueCodes[Options.DefaultMiss]; + DictionaryFrm.DictGrid.Cells[7,row] := 'L'; + end; + for row := 1 to NoVariables do + begin + DictionaryFrm.DictGrid.Cells[1,row] := OS3MainFrm.DataGrid.Cells[row,0]; + VarDefined[row] := true; + end; + OS3MainFrm.DataGrid.RowCount := (NoCases + 1); + OS3MainFrm.DataGrid.ColCount := (NoVariables + 1); + end; + GetTypes; +end; +//------------------------------------------------------------------- + +procedure SaveTabFile; +var + namestr: string; + cellvalue: string; + TabFile: TextFile; + i, j: integer; +begin + OS3MainFrm.SaveDialog1.Filter := 'Tab field files (*.tab)|*.tab;*.TAB|Text files (*.txt)|*.txt;*.TXT|All files (*.*)|*.*'; + OS3MainFrm.SaveDialog1.FilterIndex := 1; + OS3MainFrm.SaveDialog1.DefaultExt := 'tab'; + if OS3MainFrm.SaveDialog1.Execute then + begin + namestr := OS3MainFrm.SaveDialog1.FileName; + Assign(TabFile,namestr); + ReWrite(TabFile); + for i := 0 to NoCases do // wp: why not NoCases-1 ? + begin + for j := 1 to NoVariables do //write all but last with a tab + begin + cellvalue := OS3MainFrm.DataGrid.Cells[j,i]; + if cellvalue = '' then cellvalue := '.'; // wp: why not "missing value"? + cellvalue := Trim(cellvalue); // wp: why not before prev line? + if j < NoVariables then cellvalue := cellvalue + #9; + write(TabFile,cellvalue); + end; + writeln(TabFile); + end; + end; + CloseFile(TabFile); +end; +//------------------------------------------------------------------- + +function ValidValue(row, col : integer) : boolean; +var + valid: boolean; + xvalue: string; + cellstring : string; + +begin + valid := true; + if FilterOn = true then + begin + cellstring := Trim(OS3MainFrm.DataGrid.Cells[FilterCol,row]); + if cellstring = 'NO' then valid := false; + ValidValue := valid; + exit; + end; + xvalue := Trim(OS3MainFrm.DataGrid.Cells[col,row]); + if (xvalue = '') and (DictionaryFrm.DictGrid.Cells[4,col] <> 'S') + then valid := false; + if valid then // check for user-defined missing value + begin + if Trim(DictionaryFrm.DictGrid.Cells[6,col]) = xvalue then + valid := false; + end; + ValidValue := valid; +end; +//----------------------------------------------------------------------------- + +function IsFiltered(GridRow : integer) : boolean; +begin + if (FilterOn = true) and (Trim(OS3MainFrm.DataGrid.Cells[FilterCol,GridRow]) = 'NO') then + IsFiltered := true else IsFiltered := false; +end; +//------------------------------------------------------------------- + +procedure MATREAD(VAR a : DblDyneMat; + VAR norows : integer; + VAR nocols : integer; + VAR means : DblDyneVec; + VAR stddevs : DblDyneVec; + VAR NCases : integer; + VAR RowLabels : StrDyneVec; + VAR ColLabels : StrDyneVec; + filename : string); +var i, j : integer; + mat_file : TextFile; +begin + assign(mat_file,filename); + reset(mat_file); + readln(mat_file,norows); + readln(mat_file,nocols); + readln(mat_file,NCases); + for i := 1 to norows do readln(mat_file,RowLabels[i-1]); + for i := 1 to nocols do readln(mat_file,ColLabels[i-1]); + for i := 1 to nocols do readln(mat_file,means[i-1]); + for i := 1 to nocols do readln(mat_file,stddevs[i-1]); + for i := 1 to norows do + for j := 1 to nocols do + readln(mat_file,a[i-1,j-1]); + CloseFile(mat_file); +end; { matrix read routine } +//------------------------------------------------------------------- + +procedure MATSAVE(VAR a : DblDyneMat; + norows : integer; + nocols : integer; + VAR means : DblDyneVec; + VAR stddevs : DblDyneVec; + NCases : integer; + VAR RowLabels : StrDyneVec; + VAR ColLabels : StrDyneVec; + filename : string); +var i, j : integer; + mat_file : TextFile; +begin + assign(mat_file,filename); + rewrite(mat_file); + writeln(mat_file,norows); + writeln(mat_file,nocols); + writeln(mat_file,NCases); + for i := 1 to norows do writeln(mat_file,RowLabels[i-1]); + for i := 1 to nocols do writeln(mat_file,ColLabels[i-1]); + for i := 1 to nocols do writeln(mat_file,means[i-1]); + for i := 1 to nocols do writeln(mat_file,stddevs[i-1]); + for i := 1 to norows do + for j := 1 to nocols do + writeln(mat_file,a[i-1,j-1]); + CloseFile(mat_file); +end; { matrix save routine } +//------------------------------------------------------------------- + +procedure ReOpen(filename : string); +var + fileext : string; + +begin + DictLoaded := false; + + if FileExists(filename) then + begin + fileext := ExtractFileExt(filename); + OS3MainFrm.FileNameEdit.Text := filename; + OS3MainFrm.OpenDialog1.FileName := filename; + if fileext = '.CSV' then OpenCommaFile + else if fileext = '.TAB' then OpenTabFile + else if fileext = '.LAZ' then OpenOS2File + else if fileext = '.SSV' then OpenSpaceFile; + end + else begin + ShowMessage('ERROR! ' + filename + ' not found'); + exit; + end; +end; +//------------------------------------------------------------------- + +procedure OpenCommaFile; +label getit; +var + CommaFile : TextFile; + namestr : string; + astr : string; + achar : char; + respval : string; + labelsinc : boolean; + row, col : integer; + commachar : integer; +begin + commachar := ord(','); + labelsinc := false; + // check for a currently open file + if NoVariables > 1 then + begin + ShowMessage('WARNING! Close (or Save and Close) the current work.'); + exit; + end; + respval := InputBox('LABELS?','Are variable labels included?','Y'); + if respval = 'Y' then labelsinc := true; + OS3MainFrm.OpenDialog1.Filter := 'Comma field files (*.CSV)|*.CSV|Text files (*.txt)|*.TXT|All files (*.*)|*.*'; + OS3MainFrm.OpenDialog1.FilterIndex := 1; + OS3MainFrm.OpenDialog1.DefaultExt := 'CSV'; + if OS3MainFrm.OpenDialog1.Execute then + begin + NoCases := 0; + NoVariables := 0; + if labelsinc = true then row := 0 else row := 1; + col := 1; + AssignFile(CommaFile, OS3MainFrm.OpenDialog1.FileName); { File selected in dialog box } + Reset(CommaFile); + OS3MainFrm.FileNameEdit.Text := OS3MainFrm.OpenDialog1.FileName; + astr := ''; + while not EOF(CommaFile) do + begin +getit: read(CommaFile,achar); + if (ord(achar) < 9) or (ord(achar) > 127) then goto getit; + if ord(achar) = 13 then goto getit; // line feed character + if (ord(achar) <> commachar) and (ord(achar) <> 10) then // check for tab or new line + begin + astr := astr + achar; + end + else if ord(achar) = commachar then // tab character found + begin + if (not labelsinc) and (row = 1) then // create a col. label + begin + namestr := 'VAR ' + IntToStr(col); + OS3MainFrm.DataGrid.Cells[col,0] := namestr; + end; + OS3MainFrm.DataGrid.Cells[col,row] := astr; + if col > NoVariables then + begin + NoVariables := col; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + end; + col := col + 1; + astr := ''; + if col >= OS3MainFrm.DataGrid.ColCount then + OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 1; + end + else //must be new line character + begin + if (not labelsinc) and (row = 1) then // create a col. label + begin + namestr := 'VAR ' + IntToStr(col); + OS3MainFrm.DataGrid.Cells[col,0] := namestr; + end; + OS3MainFrm.DataGrid.Cells[col,row] := astr; + astr := ''; + if col > NoVariables then + begin + NoVariables := col; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + end; + col := 1; + if row > NoCases then NoCases := row; + OS3MainFrm.DataGrid.Cells[0,row] := 'Case ' + IntToStr(row); + row := row + 1; + if row >= OS3MainFrm.DataGrid.RowCount then + OS3MainFrm.DataGrid.RowCount := OS3MainFrm.DataGrid.RowCount + 1; + end; + end; // END OF FILE + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + CloseFile(CommaFile); + if NoVariables > OS3MainFrm.DataGrid.ColCount - 1 then + OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 1; + end; + OS3MainFrm.DataGrid.RowCount := (NoCases + 1); + OS3MainFrm.DataGrid.ColCount := (NoVariables + 1); + // set up the dictionary + DictionaryFrm.DictGrid.RowCount := NoVariables + 1; + DictionaryFrm.DictGrid.ColCount := 8; + for row := 1 to NoVariables do + begin + DictionaryFrm.DictGrid.Cells[0,row] := IntToStr(row); + DictionaryFrm.DictGrid.Cells[1,row] := 'VAR.' + IntToStr(row); + DictionaryFrm.DictGrid.Cells[2,row] := 'VARIABLE ' + IntToStr(row); + DictionaryFrm.DictGrid.Cells[3,row] := '8'; + DictionaryFrm.DictGrid.Cells[4,row] := 'F'; + DictionaryFrm.DictGrid.Cells[5,row] := '2'; + DictionaryFrm.DictGrid.Cells[6,row] := MissingValueCodes[Options.DefaultMiss]; + DictionaryFrm.DictGrid.Cells[7,row] := 'L'; + end; + for row := 1 to NoVariables do + begin + DictionaryFrm.DictGrid.Cells[1,row] := OS3MainFrm.DataGrid.Cells[row,0]; + VarDefined[row] := true; + end; + GetTypes; +end; +//------------------------------------------------------------------- + +procedure SaveCommaFile; +var + namestr : string; + cellvalue : string; + CommaFile : TextFile; + i, j : integer; + +begin + OS3MainFrm.SaveDialog1.Filter := 'Comma field files (*.CSV)|*.CSV|Text files (*.txt)|*.TXT|All files (*.*)|*.*'; + OS3MainFrm.SaveDialog1.FilterIndex := 1; + OS3MainFrm.SaveDialog1.DefaultExt := 'CSV'; + if OS3MainFrm.SaveDialog1.Execute then + begin + namestr := OS3MainFrm.SaveDialog1.FileName; + Assign(CommaFile,namestr); + ReWrite(CommaFile); + for i := 0 to NoCases do + begin + for j := 1 to NoVariables do //write all but last with a tab + begin + cellvalue := OS3MainFrm.DataGrid.Cells[j,i]; + if cellvalue = '' then cellvalue := '.'; + cellvalue := Trim(cellvalue); + if j < NoVariables then cellvalue := cellvalue + ','; + write(CommaFile,cellvalue); + end; + writeln(CommaFile); + end; + end; + CloseFile(CommaFile); +end; +//------------------------------------------------------------------- + +procedure OpenSpaceFile; +label getit; +var + SpaceFile : TextFile; + namestr : string; + astr : string; + achar : char; + respval : string; + labelsinc : boolean; + row, col : integer; + spacechar : integer; + spacefound : boolean; +begin + Assert(OS3MainFrm <> nil); + Assert(DictionaryFrm <> nil); + + spacechar := ord(' '); + spacefound := false; + labelsinc := false; + // check for a currently open file + if NoVariables > 1 then + begin + ShowMessage('WARNING! Close (or Save and Close) the current work.'); + exit; + end; + respval := InputBox('LABELS?','Are variable labels included?','Y'); + if respval = 'Y' then labelsinc := true; + OS3MainFrm.OpenDialog1.Filter := 'Comma field files (*.SSV)|*.SSV|Text files (*.txt)|*.TXT|All files (*.*)|*.*'; + OS3MainFrm.OpenDialog1.FilterIndex := 1; + OS3MainFrm.OpenDialog1.DefaultExt := 'SSV'; + if OS3MainFrm.OpenDialog1.Execute then + begin + NoCases := 0; + NoVariables := 0; + if labelsinc = true then row := 0 else row := 1; + col := 1; + AssignFile(SpaceFile, OS3MainFrm.OpenDialog1.FileName); { File selected in dialog box } + Reset(SpaceFile); + OS3MainFrm.FileNameEdit.Text := OS3MainFrm.OpenDialog1.FileName; + astr := ''; + while not EOF(SpaceFile) do + begin +getit: read(SpaceFile,achar); + if ord(achar) <> spacechar then spacefound := false; + if (ord(achar) < 9) or (ord(achar) > 127) then goto getit; + if ord(achar) = 13 then goto getit; // line feed character + if (ord(achar) <> spacechar) and (ord(achar) <> 10) then // check for space or new line + begin + astr := astr + achar; + end + else if ord(achar) = spacechar then // space character found + begin + if spacefound then goto getit; // extra space + if length(astr) = 0 then goto getit; // leading space + spacefound := true; + if (not labelsinc) and (row = 1) then // create a col. label + begin + namestr := 'VAR ' + IntToStr(col); + OS3MainFrm.DataGrid.Cells[col,0] := namestr; + end; + OS3MainFrm.DataGrid.Cells[col,row] := astr; + if col > NoVariables then + begin + NoVariables := col; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + end; + col := col + 1; + astr := ''; + if col >= OS3MainFrm.DataGrid.ColCount then + OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 1; + end + else //must be new line character + begin + spacefound := false; + if (not labelsinc) and (row = 1) then // create a col. label + begin + namestr := 'VAR ' + IntToStr(col); + OS3MainFrm.DataGrid.Cells[col,0] := namestr; + end; + OS3MainFrm.DataGrid.Cells[col,row] := astr; + astr := ''; + if col > NoVariables then + begin + NoVariables := col; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + end; + col := 1; + if row > NoCases then NoCases := row; + OS3MainFrm.DataGrid.Cells[0,row] := 'Case ' + IntToStr(row); + row := row + 1; + if row >= OS3MainFrm.DataGrid.RowCount then + OS3MainFrm.DataGrid.RowCount := OS3MainFrm.DataGrid.RowCount + 1; + end; + end; // END OF FILE + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + CloseFile(SpaceFile); + if NoVariables > OS3MainFrm.DataGrid.ColCount - 1 then + OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 1; + end; + OS3MainFrm.DataGrid.RowCount := (NoCases + 1); + OS3MainFrm.DataGrid.ColCount := (NoVariables + 1); + // set up the dictionary + DictionaryFrm.DictGrid.RowCount := NoVariables + 1; + DictionaryFrm.DictGrid.ColCount := 8; + for row := 1 to NoVariables do + begin + DictionaryFrm.DictGrid.Cells[0,row] := IntToStr(row); + DictionaryFrm.DictGrid.Cells[1,row] := 'VAR.' + IntToStr(row); + DictionaryFrm.DictGrid.Cells[2,row] := 'VARIABLE ' + IntToStr(row); + DictionaryFrm.DictGrid.Cells[3,row] := '8'; + DictionaryFrm.DictGrid.Cells[4,row] := 'F'; + DictionaryFrm.DictGrid.Cells[5,row] := '2'; + Dictionaryfrm.DictGrid.Cells[6,row] := MissingValueCodes[Options.DefaultMiss]; + DictionaryFrm.DictGrid.Cells[7,row] := 'L'; + end; + for row := 1 to NoVariables do + begin + DictionaryFrm.DictGrid.Cells[1,row] := OS3MainFrm.DataGrid.Cells[row,0]; + VarDefined[row] := true; + end; + GetTypes; +end; +//------------------------------------------------------------------- + +procedure SaveSpaceFile; +var + namestr : string; + cellvalue : string; + SpaceFile : TextFile; + i, j : integer; + +begin + Assert(OS3MainFrm <> nil); + + OS3MainFrm.SaveDialog1.Filter := 'Comma field files (*.SSV)|*.SSV|Text files (*.txt)|*.TXT|All files (*.*)|*.*'; + OS3MainFrm.SaveDialog1.FilterIndex := 1; + OS3MainFrm.SaveDialog1.DefaultExt := 'SSV'; + if OS3MainFrm.SaveDialog1.Execute then + begin + namestr := OS3MainFrm.SaveDialog1.FileName; + Assign(SpaceFile,namestr); + ReWrite(SpaceFile); + for i := 0 to NoCases do + begin + for j := 1 to NoVariables do //write all but last with a tab + begin + cellvalue := OS3MainFrm.DataGrid.Cells[j,i]; + if cellvalue = '' then cellvalue := '.'; + cellvalue := Trim(cellvalue); + if j < NoVariables then cellvalue := cellvalue + ' '; + write(SpaceFile,cellvalue); + end; + writeln(SpaceFile); + end; + end; + CloseFile(SpaceFile); +end; +//------------------------------------------------------------------- + +procedure InsertRow; +var + i, j, row : integer; + +begin + Assert(OS3MainFrm <> nil); + + row := OS3MainFrm.DataGrid.Row; + OS3MainFrm.DataGrid.RowCount := OS3MainFrm.DataGrid.RowCount + 1; + NoCases := OS3MainFrm.DataGrid.RowCount-1; + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases); + for i := NoCases downto row+1 do + for j := 1 to NoVariables do + OS3MainFrm.DataGrid.Cells[j,i] := OS3MainFrm.DataGrid.Cells[j,i-1]; + for j := 1 to NoVariables do + OS3MainFrm.DataGrid.Cells[j,row] := ''; + for i := 1 to NoCases do + OS3MainFrm.DataGrid.Cells[0,i] := 'CASE ' + IntToStr(i); +end; +//------------------------------------------------------------------- + +procedure OpenOSData; +var + F : TextFile; + filename : string; + astr : string; + i, j : integer; + NRows, NCols : integer; +begin + Assert(OS3MainFrm <> nil); + Assert(DictionaryFrm <> nil); + + DictLoaded := false; + OS3MainFrm.OpenDialog1.DefaultExt := '.OS2'; + OS3MainFrm.OpenDialog1.Filter := 'OpenStat2 (*.OS2)|*.OS2|Tab (*.tab)|*.TAB|space (*.SPC)|*.SPC|All files (*.*)|*.*'; + OS3MainFrm.OpenDialog1.FilterIndex := 1; + if OS3MainFrm.OpenDialog1.Execute then + begin + filename := OS3MainFrm.OpenDialog1.FileName; + OS3MainFrm.FileNameEdit.Text := filename; + AssignFile(F,filename); + Reset(F); + Readln(F,NRows); + readln(F,NCols); + + // initialize the dictionary grid for NCols of variables + // using the default formats (protective measure in case of + // a screw-up where the dictionary was damaged + DictionaryFrm.DictGrid.ColCount := 8; + DictionaryFrm.DictGrid.RowCount := NRows+1; + for i := 1 to NCols do + begin + DictionaryFrm.DictGrid.Cells[0,i] := IntToStr(i); + DictionaryFrm.DictGrid.Cells[1,i] := 'VAR.' + IntToStr(i); + DictionaryFrm.DictGrid.Cells[2,i] := 'VARIABLE ' + IntToStr(i); + DictionaryFrm.DictGrid.Cells[3,i] := '8'; + DictionaryFrm.DictGrid.Cells[4,i] := 'F'; + DictionaryFrm.DictGrid.Cells[5,i] := '2'; + DictionaryFrm.DictGrid.Cells[6,i] := ' '; + DictionaryFrm.DictGrid.Cells[7,i] := 'L'; + end; + DictionaryFrm.DescMemo.Clear; + + // Now read grid data + OS3MainFrm.DataGrid.RowCount := NRows + 1; + OS3MainFrm.DataGrid.ColCount := NCols + 1; + OS3MainFrm.NoCasesEdit.Text := IntToStr(NRows); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NCols); + NoVariables := NCols; + NoCases := NRows; + for i := 0 to NRows do // note - labels in row 0 + begin + for j := 0 to NCols do // note - case no. in col. 0 + begin + Readln(F,astr); + OS3MainFrm.DataGrid.Cells[j,i] := astr; + end; + end; + CloseFile(F); + OS3MainFrm.DataGrid.Cells[0,0] := 'CASE/VAR.'; + + // copy column names into the data dictionary. + for i := 1 to NCols do + begin + DictionaryFrm.DictGrid.Cells[1,i] := OS3MainFrm.DataGrid.Cells[i,0]; + VarDefined[i] := true; + end; + DictionaryFrm.ShowModal; + FormatGrid; + end; +end; +//------------------------------------------------------------------- + +procedure ClearGrid; +var + i, j : integer; +begin + Assert(OS3MainFrm <> nil); + + for i := 0 to NoCases do + begin + for j := 0 to NoVariables do OS3MainFrm.DataGrid.Cells[j,i] := ''; + end; + + OS3MainFrm.NoVarsEdit.Text := '0'; + OS3MainFrm.NoCasesEdit.Text := '0'; + NoVariables := 0; + NoCases := 0; + OS3MainFrm.DataGrid.RowCount := 2; + OS3MainFrm.DataGrid.ColCount := 2; + OS3MainFrm.DataGrid.Cells[0,1] := 'CASE 1'; + OS3MainFrm.DataGrid.Cells[0,0] := 'CASE/VAR.'; + +end; + +procedure CopyIt; +VAR + rowstart, rowend,colstart, colend, i, j : integer; + buf : string; + bf : pchar; + +begin + Assert(OS3MainFrm <> nil); + + Clipboard.Clear; + rowstart := OS3MainFrm.DataGrid.Selection.Top; + rowend := OS3MainFrm.DataGrid.Selection.Bottom; + colstart := OS3MainFrm.DataGrid.Selection.Left; + colend := OS3MainFrm.DataGrid.Selection.Right; + buf := ''; + for i := rowstart to rowend do + begin + for j := colstart to colend do + begin + buf := buf + OS3MainFrm.DataGrid.Cells[j,i]; + buf := buf + chr(9); // add a tab + end; + buf := buf + chr(13); // add a newline + end; + bf := PChar(buf); + Clipboard.SetTextBuf(bf); +end; + +procedure PasteIt; +VAR + astring, cellstr : string; + col, howlong, startcol : integer; + startrows :integer; + row, i, j : integer; + buf : pchar; + strarray : array[0..100000] of char; + size : integer; + achar : char; + pos : integer; + +begin + Assert(OS3MainFrm <> nil); + Assert(DictionaryFrm <> nil); + + row := OS3MainFrm.DataGrid.Row; + col := OS3MainFrm.DataGrid.Col; + startrows := row; + startcol := col; + if NoVariables = 0 then NoVariables := 1; + if VarDefined[col] = false then + begin + DictionaryFrm.DictGrid.ColCount := 8; + DictionaryFrm.NewVar(col); + end; + +// OS3MainFrm.DataGrid.RowCount := OS3MainFrm.DataGrid.RowCount + 1; + OS3MainFrm.RowEdit.Text := IntToStr(OS3MainFrm.DataGrid.RowCount-1); + if row < NoCases then // move all down before inserting + begin + for i := NoCases downto row do + for j := 1 to NoVariables do + OS3MainFrm.DataGrid.Cells[j,i+1] := OS3MainFrm.DataGrid.Cells[j,i]; + end; + OS3MainFrm.DataGrid.Row := startrows; + OS3MainFrm.DataGrid.Col := startcol; + buf := strarray; + size := 100000; + + // get clipboard info + if (Clipboard.HasFormat(CF_TEXT)) then astring := Clipboard.AsText + else + begin + ShowMessage('The clipboard does not contain text.'); + exit; + end; + + buf := strarray; + size := 100000; + ClipBoard.GetTextBuf(buf,size); + // put buf in a string to parse + astring := buf; + howlong := Length(astring); + pos := 1; + cellstr := ''; + DictionaryFrm.DictGrid.ColCount := 8; + DictionaryFrm.DictGrid.RowCount := 2; + NoVariables := OS3MainFrm.DataGrid.ColCount - 1; + while howlong > 0 do + begin + achar := astring[pos]; + if ord(achar) = 9 then // tab character - end of a grid cell value + begin + OS3MainFrm.DataGrid.Cells[col,row] := cellstr; + col := col + 1; + if col >= OS3MainFrm.DataGrid.ColCount then + begin + OS3MainFrm.DataGrid.ColCount := col; + DictionaryFrm.NewVar(col); + NoVariables := col; + end; + cellstr := ''; + pos := pos + 1; + howlong := howlong - 1; + end; + if (ord(achar) = 10) then + begin + pos := pos + 1; + howlong := howlong - 1; + end; + if (ord(achar) = 12) then + begin + pos := pos + 1; + howlong := howlong - 1; + end; + if (ord(achar) = 13) then // return character or new line - end of a row + begin + OS3MainFrm.DataGrid.Cells[col,row] := cellstr; + col := startcol; + row := row + 1; + if row >= OS3MainFrm.DataGrid.RowCount then + begin + OS3MainFrm.DataGrid.RowCount := row+1; + OS3MainFrm.DataGrid.Cells[0,row] := 'Case ' + IntToStr(row); + end; + + cellstr := ''; + pos := pos + 1; + NoCases := row - 1; + howlong := howlong - 1; + end; + if ord(achar) > 13 then + begin + cellstr := cellstr + achar; + pos := pos + 1; + howlong := howlong - 1; + end; + end; + // delete extraneous row and column + OS3MainFrm.DataGrid.Col := NoVariables; +// DeleteCol; + OS3MainFrm.DataGrid.Row := NoCases+1; +// CutaRow; + OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases+1); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); +end; + +procedure RowColSwap; +VAR + i, j, Rows, Cols : integer; + tempgrid : StrDyneMat; +begin + Assert(OS3MainFrm <> nil); + Assert(DictionaryFrm <> nil); + + SetLength(tempgrid,NoCases+1,NoVariables+1); + Rows := NoCases; + Cols := NoVariables; + + // store grid values + for i := 0 to Rows do + begin + for j := 0 to Cols do + tempgrid[i,j] := OS3MainFrm.DataGrid.Cells[j,i]; + end; + + // clear grid + ClearGrid; + + // clear dictionary + DictionaryFrm.DictGrid.ColCount := 8; + DictionaryFrm.DictGrid.RowCount := 1; + OS3MainFrm.FileNameEdit.Text := ''; + + // create new variables = NoCases + NoVariables := 0; + for i := 1 to Rows do + begin + OS3MainFrm.DataGrid.ColCount := i; + DictionaryFrm.NewVar(i); + NoVariables := i; + end; + + // store previous grid columns into the grid rows + OS3MainFrm.DataGrid.RowCount := Cols+1; + for i := 0 to Cols do + begin + for j := 1 to Rows do + begin + OS3MainFrm.DataGrid.Cells[j,i] := tempgrid[j,i]; + end; + end; + for i := 1 to Cols do // OS3MainFrm.DataGrid.Cells[0,i] := 'CASE ' + IntToStr(i); + OS3MainFrm.DataGrid.Cells[0,i] := tempgrid[0,i]; + // finish up + NoCases := Cols; + OS3MainFrm.FileNameEdit.Text := 'SwapTemp'; + OS3MainFrm.NoCasesEdit.Text := IntToStr(Cols); + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + tempgrid := nil; +end; + +procedure MatToGrid(VAR mat : DblDyneMat; nsize : integer); +VAR + i, j : integer; +Begin + Assert(OS3MainFrm <> nil); + Assert(DictionaryFrm <> nil); + + // clear grid + ClearGrid; + + // clear dictionary + DictionaryFrm.DictGrid.ColCount := 8; + DictionaryFrm.DictGrid.RowCount := 1; + OS3MainFrm.FileNameEdit.Text := ''; + + // create new variables = NoCases + NoVariables := 0; + for i := 1 to nsize do + begin + OS3MainFrm.DataGrid.ColCount := i; + DictionaryFrm.NewVar(i); + NoVariables := i; + end; + // store matrix into the grid rows + OS3MainFrm.DataGrid.RowCount := nsize + 1; + for i := 0 to nsize-1 do + begin + for j := 0 to nsize-1 do + begin + OS3MainFrm.DataGrid.Cells[i+1,j+1] := FloatToStr(mat[i,j]); + end; + end; + for i := 1 to nsize do + begin + OS3MainFrm.DataGrid.Cells[0,i] := 'VAR ' + IntToStr(i); + OS3MainFrm.DataGrid.Cells[i,0] := 'VAR ' + IntToStr(i); + end; + // finish up + NoCases := nsize; + OS3MainFrm.FileNameEdit.Text := 'MATtemp.LAZ'; + OS3MainFrm.NoCasesEdit.Text := IntToStr(nsize); + OS3MainFrm.NoVarsEdit.Text := IntToStr(nsize); +end; + +procedure GetTypes; +VAR + row,col,pos,i,strlong,intplaces,decplaces : integer; + cellstr: string; + strtype, inttype, floattype,isnumber : boolean; + comma, period, achar : char; +begin + Assert(OS3MainFrm <> nil); + Assert(DictionaryFrm <> nil); + + isnumber := false; + strtype := false; + inttype := false; + floattype := false; + comma := ','; + period := '.'; + + for col := 1 to NoVariables do + begin + for row := 1 to NoCases do + begin + cellstr := trim(OS3MainFrm.DataGrid.Cells[col,row]); + strlong := length(cellstr); + // check for a number type + for i := 1 to strlong do + if (ord(cellstr[i]) < 44) or (ord(cellstr[i]) > 57 ) or (ord(cellstr[i]) = 47 ) then + begin + isnumber := false; + break; + end + else isnumber := true; + if isnumber = false then strtype := true; + if isnumber = true then + begin // determine if an integer or float number + for i := 1 to strlong do + begin + achar := cellstr[i]; + if achar = period then floattype := true; + if achar = comma then floattype := true; + if floattype = true then + begin + pos := i; + break; + end; + end; + if floattype = false then inttype := true; + if floattype = true then + begin // get no. of decimal positions + intplaces := pos - 1; + decplaces := strlong - pos - 1; + end; + end; // end if it is a number + end; // end of row search + // set dictionary values + if strtype = true then + begin + DictionaryFrm.DictGrid.Cells[4,col] := 'S'; + DictionaryFrm.DictGrid.Cells[3,col] := IntToStr(strlong); + DictionaryFrm.DictGrid.Cells[5,col] := '0'; + end; + if inttype = true then + begin + DictionaryFrm.DictGrid.Cells[4,col] := 'I'; + DictionaryFrm.DictGrid.Cells[3,col] := IntToStr(strlong); + DictionaryFrm.DictGrid.Cells[5,col] := '0'; + end; + if floattype = true then + begin + DictionaryFrm.DictGrid.Cells[4,col] := 'F'; + DictionaryFrm.DictGrid.Cells[3,col] := IntToStr(strlong); + DictionaryFrm.DictGrid.Cells[5,col] := IntToStr(decplaces); + end; + isnumber := false; + strtype := false; + inttype := false; + floattype := false; + end; // end of column loop +end; + +function StringsToInt(strcol: integer; VAR newcol : integer; prompt : boolean) : boolean; +label endit; +VAR + i, j, k, NoStrings: integer; + TempString, response : string; + dup, savenewcol, strtype : boolean; + StrGrps, OneString : StrDyneVec; + +begin + Assert(OS3MainFrm <> nil); + Assert(DictionaryFrm <> nil); + + { Procedure to convert group strings into group integers with the option + to save the integers in the grid } + strtype := false; + savenewcol := true; + + // Get memory for arrays + SetLength(StrGrps,NoCases+1); + SetLength(OneString,NoCases+1); + + // check to see if strcol is a string variable + if DictionaryFrm.DictGrid.Cells[4,strcol] = 'S' then strtype :=true + else begin + ShowMessage('ERROR! Column selected is not defined as a string variable'); + goto endit; + end; + + // read the strings into the StrGrps array + for i := 1 to NoCases do + StrGrps[i-1] := trim(OS3MainFrm.DataGrid.Cells[strcol,i]); + + // sort the StrGrps array + for i := 0 to NoCases - 1 do + begin + for j := i + 1 to NoCases - 1 do + begin + if (StrGrps[i] > StrGrps[j]) then // swap + begin + TempString := StrGrps[i]; + StrGrps[i] := StrGrps[j]; + StrGrps[j] := TempString; + end; + end; + end; + + // copy unique strings into the OneString array + TempString := StrGrps[0]; + OneString[0] := TempString; + NoStrings := 0; + for i := 1 to NoCases do + begin + if (StrGrps[i] <> TempString) then // a new string found + begin + for k := 0 to NoCases - 1 do // check for existing + begin + if (TempString = OneString[k]) then dup := true + else dup := false; + end; + if (dup = false) then + begin + NoStrings := NoStrings + 1; + OneString[NoStrings] := StrGrps[i]; + TempString := StrGrps[i]; + end; + end; + end; + + // make a new variable in the grid for the group integers + DictionaryFrm.NewVar(NoVariables+1); + DictionaryFrm.DictGrid.Cells[1,NoVariables] := 'GroupCode'; + OS3MainFrm.DataGrid.Cells[NoVariables,0] := 'GroupCode'; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + + DictionaryFrm.DictGrid.Cells[4,NoVariables] := 'I'; + DictionaryFrm.DictGrid.Cells[5,NoVariables] := '0'; + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + newcol := NoVariables; + + // oompare case strings with OneString values and use index + 1 + // for the group code in the data grid + for i := 1 to NoCases do + begin + TempString := OS3MainFrm.DataGrid.Cells[strcol,i]; + for j := 0 to NoCases-1 do + begin + if (TempString = OneString[j]) then + OS3MainFrm.DataGrid.Cells[NoVariables,i] := IntToStr(j+1); + end; + end; + + // see if user wants to save the generated group codes + if (prompt = true) then + begin + response := InputBox('Save Code in Grid?','Y or N','Y'); + if ((response = 'n') or (response = 'N')) then + savenewcol := false; + end; + + // clean up memory +endit: OneString := nil; + StrGrps := nil; + + // return results + StringsToInt := savenewcol; +end; + + + +end. diff --git a/applications/lazstats/source/units/functionslib.pas b/applications/lazstats/source/units/functionslib.pas new file mode 100644 index 000000000..ce252a7e4 --- /dev/null +++ b/applications/lazstats/source/units/functionslib.pas @@ -0,0 +1,2420 @@ +unit FunctionsLib; + +{$mode objfpc}{$H+} + +interface + +uses + Forms, Controls, LResources, ExtCtrls, StdCtrls, Classes, SysUtils, Globals, + Graphics, Dialogs, Math, MainUnit, OutPutUnit, dataprocs; + +function chisquaredprob(X : double; k : integer) : double; +function gammln(xx : double) : double; +PROCEDURE matinv(VAR a, vtimesw, v, w: DblDyneMat; n: integer); +FUNCTION sign(a,b: double): double; +FUNCTION isign(a,b : integer): integer; +FUNCTION max(a,b: double): double; +function inversez(prob : double) : double; +function zprob(p : double; VAR errorstate : boolean) : double; +function probz(z : double) : double; +function simpsonintegral(a,b : real) : real; +function zdensity(z : real) : real; +function probf(f,df1,df2 : extended) : extended; +FUNCTION alnorm(x : double; upper : boolean): double; +procedure ppnd7 (p : double; VAR normal_dev : double; VAR ifault : integer); +FUNCTION poly(c : Array of double; nord : integer; x : double): double; // RESULT(fn_val) +procedure swilk (var init : boolean; var x : DblDyneVec; n : integer; n1 : integer; + n2 : integer; var a : DblDyneVec; var w : double; var pw : double; var ifault : integer); +procedure SVDinverse(VAR a : DblDyneMat; N : integer); +function probt(t,df1 : double) : double; +function inverset(Probt, DF : double) : double; +function inversechi(p : double; k : integer) : double; +function STUDENT(q,v,r : real) : real; +function realraise(base,power : double ): double; +function fpercentpoint(p : real; k1,k2 : integer) : real; +function lngamma(w : real) : real; +function betaratio(x,a,b,lnbeta : real) : real; +function inversebetaratio(ratio,a,b,lnbeta : real) : real; +function ProdSums(N, A : double) : double; +function combos(X, N : double) : double; +function ordinate(z : double) : double; +procedure Rank(v1col : integer; VAR Values : DblDyneVec); +procedure PRank(v1col : integer; VAR Values : DblDyneVec); +function UniStats(N : integer; VAR X : DblDyneVec; VAR z : DblDyneVec; + VAR Mean : double; VAR variance : double; VAR SD : double; + VAR Skew : double; VAR Kurtosis : double; VAR SEmean : double; + VAR SESkew : double; VAR SEkurtosis : double; VAR min : double; + VAR max : double; VAR Range : double; VAR MissValue : string) : + integer; +function WholeValue(value : double) : double; +function FractionValue(value : double) : double; +function Quartiles(TypeQ : integer; pcntile : double; N : integer; + VAR values : DblDyneVec) : double; +function KolmogorovProb(z : double) : double; +function KolmogorovTest(na : integer; VAR a : DblDyneVec; nb : integer; + VAR b : DblDyneVec; option : String) : double; +procedure poisson_cdf ( x : integer; a : double; VAR cdf : double ); +procedure poisson_cdf_values (VAR n : integer; VAR a : double; VAR x : integer; + VAR fx : double ); +procedure poisson_cdf_inv (VAR cdf : double; VAR a : double; VAR x : integer ); +procedure poisson_check ( a : double ); +function factorial(x : integer) : integer; +procedure poisson_pdf ( x : integer; VAR a : double; VAR pdf : double ); + +function DegToRad(Deg: Double): Double; + +implementation + +function chisquaredprob(X : double; k : integer) : double; +var + factor : double; // factor which multiplies sum of series + g : double; // lngamma(k1+1) + k1 : double; // adjusted degrees of freedom + sum : double; // temporary storage for partial sums + term : double; // term of series + x1 : double; // adjusted argument of funtion + chi2prob : double; // chi-squared probability +begin + // the distribution function of the chi-squared distribution based on k d.f. + if (X < 0.01) or (X > 1000.0) then + begin + if X < 0.01 then chi2prob := 0.0001 + else chi2prob := 0.999; + end + else + begin + x1 := 0.5 * X; + k1 := 0.5 * k; + g := gammln(k1 + 1); + factor := exp(k1 * ln(x1) - g - x1); + sum := 0.0; + if factor > 0 then + begin + term := 1.0; + sum := 1.0; + while ((term / sum) > 0.000001) do + begin + k1 := k1 + 1; + term := term * (x1 / k1); + sum := sum + term; + end; + end; + chi2prob := sum * factor; + end; //end if .. else + Result := chi2prob; +end; +//--------------------------------------------------------------------- + +function gammln(xx : double) : double; +var + X, tmp, ser : double; + cof : array[0..5] of double; + j : integer; + +begin + cof[0] := 76.18009173; + cof[1] := -86.50532033; + cof[2] := 24.01409822; + cof[3] := -1.231739516; + cof[4] := 0.00120858003; + cof[5] := -0.00000536382; + + X := xx - 1.0; + tmp := X + 5.5; + tmp := tmp - ((X + 0.5) * ln(tmp)); + ser := 1.0; + for j := 0 to 5 do + begin + X := X + 1.0; + ser := ser + cof[j] / X; + end; + Result := ( -tmp + ln(2.50662827465 * ser) ); +end; +//------------------------------------------------------------------- + +PROCEDURE matinv(VAR a, vtimesw, v, w: DblDyneMat; n: integer); +(* adapted from the singular value decomposition of a matrix *) +(* a is a symetric matrix with the inverse returned in a *) + +LABEL 1,2,3; + +VAR +// vtimesw, v, ainverse : matrix; +// w : vector; + ainverse : array of array of double; + m, nm,l,k,j,its,i: integer; + z,y,x,scale,s,h,g,f,c,anorm: double; + rv1: array of double; + +BEGIN + setlength(rv1,n); + setlength(ainverse,n,n); + m := n; +// mp := n; +// np := n; + g := 0.0; + scale := 0.0; + anorm := 0.0; + FOR i := 0 to n-1 DO BEGIN + l := i+1; + rv1[i] := scale*g; + g := 0.0; + s := 0.0; + scale := 0.0; + IF (i <= m-1) THEN BEGIN + FOR k := i to m-1 DO BEGIN + scale := scale+abs(a[k,i]) + END; + IF (scale <> 0.0) THEN BEGIN + FOR k := i to m-1 DO BEGIN + a[k,i] := a[k,i]/scale; + s := s+a[k,i]*a[k,i] + END; + f := a[i,i]; + g := -sign(sqrt(s),f); + h := f*g-s; + a[i,i] := f-g; + IF (i <> n-1) THEN BEGIN + FOR j := l to n-1 DO BEGIN + s := 0.0; + FOR k := i to m-1 DO BEGIN + s := s+a[k,i]*a[k,j] + END; + f := s/h; + FOR k := i to m-1 DO BEGIN + a[k,j] := a[k,j]+ + f*a[k,i] + END + END + END; + FOR k := i to m-1 DO BEGIN + a[k,i] := scale*a[k,i] + END + END + END; + w[i,i] := scale*g; + g := 0.0; + s := 0.0; + scale := 0.0; + IF ((i <= m-1) AND (i <> n-1)) THEN BEGIN + FOR k := l to n-1 DO BEGIN + scale := scale+abs(a[i,k]) + END; + IF (scale <> 0.0) THEN BEGIN + FOR k := l to n-1 DO BEGIN + a[i,k] := a[i,k]/scale; + s := s+a[i,k]*a[i,k] + END; + f := a[i,l]; + g := -sign(sqrt(s),f); + h := f*g-s; + a[i,l] := f-g; + FOR k := l to n-1 DO BEGIN + rv1[k] := a[i,k]/h + END; + IF (i <> m-1) THEN BEGIN + FOR j := l to m-1 DO BEGIN + s := 0.0; + FOR k := l to n-1 DO BEGIN + s := s+a[j,k]*a[i,k] + END; + FOR k := l to n-1 DO BEGIN + a[j,k] := a[j,k] + +s*rv1[k] + END + END + END; + FOR k := l to n-1 DO BEGIN + a[i,k] := scale*a[i,k] + END + END + END; + anorm := max(anorm,(abs(w[i,i])+abs(rv1[i]))) + END; + FOR i := n-1 DOWNTO 0 DO BEGIN + IF (i < n-1) THEN BEGIN + IF (g <> 0.0) THEN BEGIN + FOR j := l to n-1 DO BEGIN + v[j,i] := (a[i,j]/a[i,l])/g + END; + FOR j := l to n-1 DO BEGIN + s := 0.0; + FOR k := l to n-1 DO BEGIN + s := s+a[i,k]*v[k,j] + END; + FOR k := l to n-1 DO BEGIN + v[k,j] := v[k,j]+s*v[k,i] + END + END + END; + FOR j := l to n-1 DO BEGIN + v[i,j] := 0.0; + v[j,i] := 0.0 + END + END; + v[i,i] := 1.0; + g := rv1[i]; + l := i + END; + FOR i := n-1 DOWNTO 0 DO BEGIN + l := i+1; + g := w[i,i]; + IF (i < n-1) THEN BEGIN + FOR j := l to n-1 DO BEGIN + a[i,j] := 0.0 + END + END; + IF (g <> 0.0) THEN BEGIN + g := 1.0/g; + IF (i <> n-1) THEN BEGIN + FOR j := l to n-1 DO BEGIN + s := 0.0; + FOR k := l to m-1 DO BEGIN + s := s+a[k,i]*a[k,j] + END; + f := (s/a[i,i])*g; + FOR k := i to m-1 DO BEGIN + a[k,j] := a[k,j]+f*a[k,i] + END + END + END; + FOR j := i to m-1 DO BEGIN + a[j,i] := a[j,i]*g + END + END ELSE BEGIN + FOR j := i to m-1 DO BEGIN + a[j,i] := 0.0 + END + END; + a[i,i] := a[i,i]+1.0 + END; + FOR k := n-1 DOWNTO 0 DO BEGIN + FOR its := 1 to 30 DO BEGIN + FOR l := k DOWNTO 0 DO BEGIN + nm := l-1; + IF ((abs(rv1[l])+anorm) = anorm) THEN GOTO 2; + IF ((abs(w[nm,nm])+anorm) = anorm) THEN GOTO 1 + END; +1: +// c := 0.0; + s := 1.0; + FOR i := l to k DO BEGIN + f := s*rv1[i]; + IF ((abs(f)+anorm) <> anorm) THEN BEGIN + g := w[i,i]; + h := sqrt(f*f+g*g); + w[i,i] := h; + h := 1.0/h; + c := (g*h); + s := -(f*h); + FOR j := 0 to m-1 DO BEGIN + y := a[j,nm]; + z := a[j,i]; + a[j,nm] := (y*c)+(z*s); + a[j,i] := -(y*s)+(z*c) + END + END + END; +2: z := w[k,k]; + IF (l = k) THEN BEGIN + IF (z < 0.0) THEN BEGIN + w[k,k] := -z; + FOR j := 0 to n-1 DO BEGIN + v[j,k] := -v[j,k] + END + END; + GOTO 3 + END; + IF (its = 30) THEN BEGIN + { showmessage('No convergence in 30 SVDCMP iterations');} + exit; + END; + x := w[l,l]; + nm := k-1; + y := w[nm,nm]; + g := rv1[nm]; + h := rv1[k]; + f := ((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y); + g := sqrt(f*f+1.0); + f := ((x-z)*(x+z)+h*((y/(f+sign(g,f)))-h))/x; + c := 1.0; + s := 1.0; + FOR j := l to nm DO BEGIN + i := j+1; + g := rv1[i]; + y := w[i,i]; + h := s*g; + g := c*g; + z := sqrt(f*f+h*h); + rv1[j] := z; + c := f/z; + s := h/z; + f := (x*c)+(g*s); + g := -(x*s)+(g*c); + h := y*s; + y := y*c; + FOR nm := 0 to n-1 DO BEGIN + x := v[nm,j]; + z := v[nm,i]; + v[nm,j] := (x*c)+(z*s); + v[nm,i] := -(x*s)+(z*c) + END; + z := sqrt(f*f+h*h); + w[j,j] := z; + IF (z <> 0.0) THEN BEGIN + z := 1.0/z; + c := f*z; + s := h*z + END; + f := (c*g)+(s*y); + x := -(s*g)+(c*y); + FOR nm := 0 to m-1 DO BEGIN + y := a[nm,j]; + z := a[nm,i]; + a[nm,j] := (y*c)+(z*s); + a[nm,i] := -(y*s)+(z*c) + END + END; + rv1[l] := 0.0; + rv1[k] := f; + w[k,k] := x + END; +3: END; +{ mat_print(m,a,'U matrix'); + mat_print(n,v,'V matrix'); + writeln(lst,'Diagonal values of W inverse matrix'); + for i := 1 to n do + write(lst,1/w[i]:6:3); + writeln(lst); } + for i := 0 to n-1 do + for j := 0 to n-1 do + begin + if w[j,j] < 1.0e-6 then vtimesw[i,j] := 0 + else vtimesw[i,j] := v[i,j] * (1.0 / w[j,j] ); + end; +{ mat_print(n,vtimesw,'V matrix times w inverse '); } + for i := 0 to m-1 do + for j := 0 to n-1 do + begin + ainverse[i,j] := 0.0; + for k := 0 to m-1 do + begin + ainverse[i,j] := ainverse[i,j] + vtimesw[i,k] * a[j,k] + end; + end; +{ mat_print(n,ainverse,'Inverse Matrix'); } + for i := 0 to n-1 do + for j := 0 to n-1 do + a[i,j] := ainverse[i,j]; + ainverse := nil; + rv1 := nil; +END; +//------------------------------------------------------------------- + +FUNCTION sign(a,b: double): double; +BEGIN + IF (b >= 0.0) THEN sign := abs(a) ELSE sign := -abs(a) +END; +//------------------------------------------------------------------- + +FUNCTION isign(a,b : integer): integer; +BEGIN + IF (b >= 0) then isign := abs(a) ELSE isign := -abs(a) +END; +//------------------------------------------------------------------- + +FUNCTION max(a,b: double): double; +BEGIN + IF (a > b) THEN max := a ELSE max := b +END; +//------------------------------------------------------------------- + +function inversez(prob : double) : double; +var + z, p : double; + flag : boolean = false; +begin + // obtains the inverse of z, that is, the z for a probability associated + // with a normally distributed z score. + p := prob; + if (prob > 0.5) then p := 1.0 - prob; + z := zprob(p,flag); + if (prob > 0.5) then z := abs(z); + inversez := z; +end; //End of inversez Function +//------------------------------------------------------------------- + +function zprob(p : double; VAR errorstate : boolean) : double; +VAR + z, xp, lim, p0, p1, p2, p3, p4, q0, q1, q2, q3, q4, Y : double; +begin + // value of probability between approx. 0 and .5 entered in p and the + // z value is returned z + errorstate := true; + lim := 1E-19; + p0 := -0.322232431088; + p1 := -1.0; + p2 := -0.342242088547; + p3 := -0.0204231210245; + p4 := -4.53642210148E-05; + q0 := 0.099348462606; + q1 := 0.588581570495; + q2 := 0.531103462366; + q3 := 0.10353775285; + q4 := 0.0038560700634; + xp := 0.0; + if (p > 0.5) then p := 1 - p; + if (p < lim) then z := xp + else + begin + errorstate := false; + if (p = 0.5) then z := xp + else + begin + Y := sqrt(ln(1.0 / (p * p))); + xp := Y + ((((Y * p4 + p3) * Y + p2) * Y + p1) * Y + p0) / + ((((Y * q4 + q3) * Y + q2) * Y + q1) * Y + q0); + if (p < 0.5) then xp := -xp; + z := xp; + end; + end; + zprob := z; +end; // End function zprob +//------------------------------------------------------------------- + +function probz(z : double) : double; +(* the distribution function of the standard normal distribution derived *) +(* by integration using simpson's rule . *) + +begin + Result := 0.5 + simpsonintegral(0.0,z); +end; +//----------------------------------------------------------------------- + +function simpsonintegral(a,b : real) : real; +(* integrates the function f from lower a to upper limit b choosing an *) +(* interval length so that the error is less than a given amount - *) +(* the default value is 1.0e-06 *) +const error = 1.0e-4 ; + +var h : real; (* current length of interval *) + i : integer; (* counter *) + integral : real; (* current approximation to integral *) + lastint : real; (* previous approximation *) + n : integer; (* no. of intervals *) + sum1,sum2,sum4 : real; (* sums of function values *) + +begin + n := 2 ; h := 0.5 * (b - a); + sum1 := h * (zdensity(a) + zdensity(b) ); + sum2 := 0; + sum4 := zdensity( 0.5 * (a + b)); + integral := h * (sum1 + 4 * sum4); + repeat + lastint := integral; n := n + n; h := 0.5*h; + sum2 := sum2 + sum4; + sum4 := 0; i := 1; + repeat + sum4 := sum4 + zdensity(a + i*h); + i := i + 2 + until i > n; + integral := h * (sum1 + 2*sum2 + 4*sum4); + until abs(integral - lastint) < error; + simpsonintegral := integral/3 +end; (* of SimpsonIntegral *) +//--------------------------------------------------------------------- + +function zdensity(z : real) : real; +(* the density function of the standard normal distribution *) +const a = 0.39894228; (* 1 / sqrt(2*pi) *) + +begin + Result := a * exp(-0.5 * z*z ) +end; (* of normal *) +//---------------------------------------------------------------------- + + +function probf(f,df1,df2 : extended) : extended; +var + term1, term2, term3, term4, term5, term6 : extended; + +FUNCTION gammln(xx: extended): extended; + +CONST + stp = 2.50662827465; +// half = 0.5; + one = 1.0; + fpf = 5.5; + +VAR + x,tmp,ser: double; + j: integer; + cof: ARRAY [1..6] OF extended; + +BEGIN + cof[1] := 76.18009173; + cof[2] := -86.50532033; + cof[3] := 24.01409822; + cof[4] := -1.231739516; + cof[5] := 0.120858003e-2; + cof[6] := -0.536382e-5; + x := xx - 1.0; + tmp := x + fpf; + term1 := ln(tmp); + term2 := (x + 0.5) * term1; + tmp := term2 - tmp; + ser := one; + FOR j := 1 to 6 DO BEGIN + x := x + 1.0; + ser := ser + cof[j] / x + END; + gammln := tmp +ln(stp * ser) +END; +//----------------------------------------------------------------- + +FUNCTION betacf(a,b,x: double): extended; +LABEL 1; +CONST + itmax=100; + eps=3.0e-7; +VAR + tem,qap,qam,qab,em,d: extended; + bz,bpp,bp,bm,az,app: extended; + am,aold,ap: extended; + m: integer; + +BEGIN + am := 1.0; + bm := 1.0; + az := 1.0; + qab := a+b; + qap := a+1.0; + qam := a-1.0; + bz := 1.0 - qab * x / qap; + FOR m := 1 to itmax DO BEGIN + em := m; + tem := em+em; + d := em * (b - m) * x / ((qam + tem) * (a + tem)); + ap := az + d * am; + bp := bz + d * bm; + term1 := -(a + em); + term2 := qab + em; + term3 := term1 * term2 * x; + term4 := a + tem; + term5 := qap + tem; + term6 := term4 * term5; + d := term3 / term6; + app := ap + d * az; + bpp := bp + d * bz; + aold := az; + am := ap/bpp; + bm := bp/bpp; + az := app/bpp; + bz := 1.0; + IF ((abs(az-aold)) < (eps*abs(az))) THEN GOTO 1 + END; + { ShowMessage('WARNING! a or b too big, or itmax too small in betacf');} +1: betacf := az +END; + +FUNCTION betai(a,b,x: extended): extended; +VAR + bt: extended; +BEGIN + IF ((x <= 0.0) OR (x >= 1.0)) THEN BEGIN + { ShowMessage('ERROR! Problem in routine BETAI');} + betai := 0.5; + exit; + END; + IF ((x <= 0.0) OR (x >= 1.0)) THEN bt := 0.0 + ELSE + begin + term1 := gammln(a + b) - + gammln(a) - gammln(b); + term2 := a * ln(x); + term3 := b * ln(1.0 - x); + term4 := term1 + term2 + term3; + bt := exp(term4); + term5 := (a + 1.0) / (a + b + 2.0); + end; + IF x < term5 then betai := bt * betacf(a,b,x) / a + ELSE betai := 1.0 - bt * betacf(b,a,1.0-x) / b +END; + +begin { fprob function } + if f <= 0.0 then probf := 1.0 else + probf := (betai(0.5*df2,0.5*df1,df2/(df2+df1*f)) + + (1.0-betai(0.5*df1,0.5*df2,df1/(df1+df2/f))))/2.0; +end; // of fprob function +//-------------------------------------------------------------------- + +FUNCTION alnorm(x : double; upper : boolean): double; +// Algorithm AS66 Applied Statistics (1973) vol.22, no.3 +// Evaluates the tail area of the standardised normal curve +// from x to infinity if upper is .true. or +// from minus infinity to x if upper is .false. +// ELF90-compatible version by Alan Miller +// Latest revision - 29 November 1997 + +label L10, L20, L30, L40; +var + fn_val : double; +// sp : integer; + zero, one, half, con : double; + z, y : double; + up : boolean; + ltone, utzero : double; + p, q, r, a1, a2, a3, b1, b2, c1, c2, c3, c4, c5, c6 : double; + d1, d2, d3, d4, d5 : double; + +begin + zero := 0.0; + one := 1.0; + half := 0.5; + con := 1.28; + ltone := 7.0; + utzero := 18.66; + p := 0.398942280444; + q := 0.39990348504; + r := 0.398942280385; + a1 := 5.75885480458; + a2 := 2.62433121679; + a3 := 5.92885724438; + b1 := -29.8213557807; + b2 := 48.6959930692; + c1 := -3.8052E-8; + c2 := 3.98064794E-4; + c3 := -0.151679116635; + c4 := 4.8385912808; + c5 := 0.742380924027; + c6 := 3.99019417011; + d1 := 1.00000615302; + d2 := 1.98615381364; + d3 := 5.29330324926; + d4 := -15.1508972451; + d5 := 30.789933034; + up := upper; + z := x; + IF(z >= zero) then GOTO L10; + up := NOT up; + z := -z; +L10 : + IF ((z <= ltone) OR (up) AND (z <= utzero)) then GOTO L20; + fn_val := zero; + GOTO L40; +L20 : + y := half*z*z; + IF(z > con) then GOTO L30; + + fn_val := half - z*(p-q*y/(y+a1+b1/(y+a2+b2/(y+a3)))); + GOTO L40; +L30 : + fn_val := r*EXP(-y)/(z+c1+d1/(z+c2+d2/(z+c3+d3/(z+c4+d4/(z+c5+d5/(z+c6)))))); +L40 : + IF(NOT up) then fn_val := one - fn_val; + + result := fn_val; +END; // FUNCTION alnorm +//----------------------------------------------------------------------------------- + +procedure ppnd7 (p : double; VAR normal_dev : double; VAR ifault : integer); +// ALGORITHM AS241 APPL. STATIST. (1988) VOL. 37, NO. 3, 477- 484. +// Produces the normal deviate Z corresponding to a given lower tail area of P; +// Z is accurate to about 1 part in 10**7. + +// This ELF90-compatible version by Alan Miller - 20 August 1996 +// N.B. The original algorithm is as a function; this is a subroutine + +var + zero, one, half, split1, split2, const1, const2, q, r : double; + a0, a1, a2, a3, b1, b2, b3 : double; + c0, c1, c2, c3, d1, d2 : double; + e0, e1, e2, e3, f1, f2 : double; + +begin + zero := 0.0; + one := 1.0; + half := 0.5; + split1 := 0.425; + split2 := 5.0; + const1 := 0.180625; + const2 := 1.6; + a0 := 3.3871327179E+00; + a1 := 5.0434271938E+01; + a2 := 1.5929113202E+02; + a3 := 5.9109374720E+01; + b1 := 1.7895169469E+01; + b2 := 7.8757757664E+01; + b3 := 6.7187563600E+01; + c0 := 1.4234372777E+00; + c1 := 2.7568153900E+00; + c2 := 1.3067284816E+00; + c3 := 1.7023821103E-01; + d1 := 7.3700164250E-01; + d2 := 1.2021132975E-01; + e0 := 6.6579051150E+00; + e1 := 3.0812263860E+00; + e2 := 4.2868294337E-01; + e3 := 1.7337203997E-02; + f1 := 2.4197894225E-01; + f2 := 1.2258202635E-02; + ifault := 0; + q := p - half; + IF (ABS(q) <= split1) THEN + begin + r := const1 - q * q; + normal_dev := q * (((a3 * r + a2) * r + a1) * r + a0) / (((b3 * r + b2) * r + b1) * r + one); + exit; // RETURN + end + ELSE begin + IF (q < zero) THEN r := p ELSE r := one - p; + IF (r <= zero) THEN + begin + ifault := 1; + normal_dev := zero; + exit; //RETURN + END; // IF + r := SQRT(-ln(r)); + IF (r <= split2) THEN + begin + r := r - const2; + normal_dev := (((c3 * r + c2) * r + c1) * r + c0) / ((d2 * r + d1) * r + one); + end + ELSE begin + r := r - split2; + normal_dev := (((e3 * r + e2) * r + e1) * r + e0) / ((f2 * r + f1) * r + one); + END; // IF + IF (q < zero) then normal_dev := - normal_dev; + exit; + end; // if +end; // procedure ppnd7 +//--------------------------------------------------------------------- + +FUNCTION poly(c : Array of double; nord : integer; x : double): double; // RESULT(fn_val) +// Algorithm AS 181.2 Appl. Statist. (1982) Vol. 31, No. 2 +// Calculates the algebraic polynomial of order nored-1 with +// array of coefficients c. Zero order coefficient is c(1) +label 20; +var + fn_val, p : double; + i, j, n2 : integer; + c2 : array[1..6] of double; +begin + // copy into array for access starting at 1 instead of zero + for i := 1 to nord do c2[i] := c[i-1]; + + fn_val := c2[1]; + IF (nord = 1) then + begin + result := fn_val; + exit; // RETURN + end; + p := x * c2[nord]; + IF (nord = 2) then GOTO 20; + n2 := nord - 2; + j := n2 + 1; + for i := 1 to n2 do + begin + p := (p + c2[j])*x; + j := j - 1; + END; // DO +20: fn_val := fn_val + p; + + result := fn_val; +END; // FUNCTION poly +//----------------------------------------------------------------------- + +procedure swilk (var init : boolean; var x : DblDyneVec; n : integer; n1 : integer; + n2 : integer; var a : DblDyneVec; var w : double; var pw : double; var ifault : integer); + +// ALGORITHM AS R94 APPL. STATIST. (1995) VOL.44, NO.4 +// Calculates the Shapiro-Wilk W test and its significance level + +// ARGUMENTS: +// INIT Set to .FALSE. on the first call so that weights A(N2) can be +// calculated. Set to .TRUE. on exit unless IFAULT = 1 or 3. +// X(N1) Sample values in ascending order. +// N The total sample size (including any right-censored values). +// N1 The number of uncensored cases (N1 <= N). +// N2 Integer part of N/2. +// A(N2) The calculated weights. +// W The Shapiro-Wilks W-statistic. +// PW The P-value for W. +// IFAULT Error indicator: +// = 0 for no error +// = 1 if N1 < 3 +// = 2 if N > 5000 (a non-fatal error) +// = 3 if N2 < N/2 +// = 4 if N1 > N or (N1 < N and N < 20). +// = 5 if the proportion censored (N - N1)/N > 0.8. +// = 6 if the data have zero range. +// = 7 if the X's are not sorted in increasing order + +// Fortran 90 version by Alan.Miller @ vic.cmis.csiro.au +// Latest revision - 4 December 1998 + +label + 70; +const + z90 = 1.2816; + z95 = 1.6449; + z99 = 2.3263; + zm = 1.7509; + zss = 0.56268; + bf1 = 0.8378; + xx90 = 0.556; + xx95 = 0.622; + zero = 0.0; + one = 1.0; + two = 2.0; + three= 3.0; + sqrth= 0.70711; + qtr = 0.25; + th = 0.375; + small= 1E-19; + pi6 = 1.909859; + stqr = 1.047198; + c1: array[1..6] of double = (0.0, 0.221157, -0.147981, -2.07119, 4.434685, -2.706056); + c2: array[1..6] of double = (0.0, 0.042981, -0.293762, -1.752461, 5.682633, -3.582633); + c3: array[1..4] of double = (0.5440, -0.39978, 0.025054, -0.6714E-3); + c4: array[1..4] of double = (1.3822, -0.77857, 0.062767, -0.0020322); + c5: array[1..4] of double = (-1.5861, -0.31082, -0.083751, 0.0038915); + c6: array[1..3] of double = (-0.4803, -0.082676, 0.0030302); + c7: array[1..2] of double = (0.164, 0.533); + c8: array[1..2] of double = (0.1736, 0.315); + c9: array[1..2] of double = (0.256, -0.00635); + g: array[1..2] of double = (-2.273, 0.459); +var + summ2, ssumm2, fac, rsn, an, an25, a1, a2, delta, range: double; + sa, sx, ssx, ssa, sax, asa, xsx, ssassx, w1, y, xx, xi: double; + gamma, m, s, ld, bf, z90f, z95f, z99f, zfm, zsd, zbar: double; + ncens, nn2, i, i1, j: integer; + upper: boolean; +begin + upper := true; + pw := one; + if (w >= zero) then w := one; + an := n; + ifault := 3; + nn2 := n div 2; + if (n2 < nn2) then exit; + ifault := 1; + if (n < 3) then exit; + + // If INIT is false, calculate coefficients for the test + if (not init) then + begin + if (n = 3) then + a[1] := sqrth + else + begin + an25 := an + qtr; + summ2 := zero; + for i := 1 to n2 do + begin + ppnd7((i - th)/an25, a[i], ifault); + summ2 := summ2 + (a[i] * a[i]); + end; + summ2 := summ2 * two; + ssumm2 := SQRT(summ2); + rsn := one / SQRT(an); + a1 := poly(c1, 6, rsn) - a[1] / ssumm2; + + // Normalize coefficients + if (n > 5) then + begin + i1 := 3; + a2 := -a[2]/ssumm2 + poly(c2,6,rsn); + fac := SQRT( + (summ2 - two * a[1] * a[1] - two * a[2] * a[2])/ + (one - two * power(a1,2) - two * power(a2,2)) + ); + a[1] := a1; + a[2] := a2; + end + else begin + i1 := 2; + fac := SQRT((summ2 - two * a[1] * a[1])/ (one - two * a1 * a1)); + a[1] := a1; + end; + for i := i1 to nn2 do + a[i] := -a[i]/fac; + end; + init := true; + end; + if (n1 < 3) then + exit; + + ncens := n - n1; + ifault := 4; + if (ncens < 0) or ((ncens > 0) and (n < 20)) then exit; + ifault := 5; + delta := ncens/an; + if (delta > 0.8) then exit; + +// If W input as negative, calculate significance level of -W + if (w < zero) then + begin + w1 := one + w; + ifault := 0; + GOTO 70; + end; // IF + +// Check for zero range + ifault := 6; + range := x[n1] - x[1]; + if (range < small) then exit; //RETURN + +// Check for correct sort order on range - scaled X + ifault := 7; + xx := x[1] / range; + sx := xx; + sa := -a[1]; + j := n - 1; + for i := 2 to n1 do + begin + xi := x[i]/range; + if (xx-xi > small) then + begin + { ShowMessage('x[i]s out of order'); // WRITE(*, *) 'x(i)s out of order'} + exit;// RETURN + end; // IF + sx := sx + xi; + if (i <> j) then sa := sa + SIGN(1, i - j) * a[MIN(i, j)]; + xx := xi; + j := j - 1; + end; // DO + + ifault := 0; + if (n > 5000) then ifault := 2; + +// Calculate W statistic as squared correlation +// between data and coefficients + sa := sa/n1; + sx := sx/n1; + ssa := zero; + ssx := zero; + sax := zero; + j := n; + for i := 1 to n1 do + begin + if (i <> j) then + asa := SIGN(1, i - j) * a[MIN(i, j)] - sa + else + asa := -sa; + xsx := x[i]/range - sx; + ssa := ssa + asa * asa; + ssx := ssx + xsx * xsx; + sax := sax + asa * xsx; + j := j - 1; + end; // DO + +// W1 equals (1-W) claculated to avoid excessive rounding error +// for W very near 1 (a potential problem in very large samples) + ssassx := SQRT(ssa * ssx); + w1 := (ssassx - sax) * (ssassx + sax)/(ssa * ssx); +70: w := one - w1; + +// Calculate significance level for W (exact for N=3) + if (n = 3) then + begin + pw := pi6 * (ARCSIN(SQRT(w)) - stqr); + exit; //RETURN + end; // IF + y := LN(w1); + xx := LN(an); +// m := zero; +// s := one; + if (n <= 11) then + begin + gamma := poly(g, 2, an); + if (y >= gamma) then + begin + pw := small; + exit; //RETURN + end; // IF + y := -LN(gamma - y); + m := poly(c3, 4, an); + s := EXP(poly(c4, 4, an)); + end + else begin + m := poly(c5, 4, xx); + s := EXP(poly(c6, 3, xx)); + end; // IF + if (ncens > 0) then + begin +// Censoring by proportion NCENS/N. Calculate mean and sd +// of normal equivalent deviate of W. + ld := -LN(delta); + bf := one + xx * bf1; + z90f := z90 + bf * power(poly(c7, 2, power(xx90,xx)),ld); + z95f := z95 + bf * power(poly(c8, 2, power(xx95,xx)),ld); + z99f := z99 + bf * power(poly(c9, 2, xx),ld); + +// Regress Z90F,...,Z99F on normal deviates Z90,...,Z99 to get +// pseudo-mean and pseudo-sd of z as the slope and intercept + zfm := (z90f + z95f + z99f)/three; + zsd := (z90*(z90f-zfm)+z95*(z95f-zfm)+z99*(z99f-zfm))/zss; + zbar := zfm - zsd * zm; + m := m + zbar * s; + s := s * zsd; + end; // IF + pw := alnorm((y - m)/s, upper); +end; // procedure +//----------------------------------------------------------------------- + +procedure SVDinverse(VAR a : DblDyneMat; N : integer); +// a shorter version of the matinv routine that ignores v, w, and vtimes w +// matrices in the singular value decompensation inverse procedure +var + v, w, vtimesw : DblDyneMat; +begin + SetLength(v,N,N); + SetLength(w,N,N); + SetLength(vtimesw,N,N); + matinv(a,vtimesw,v,w,N); +end; +//------------------------------------------------------------------- + +function probt(t,df1 : double) : double; +var + F, prob : double; +begin + // Returns the probability corresponding to a two-tailed t test. + F := t * t; + prob := probf(F,1.0,df1); + Result := prob; +end; +//------------------------------------------------------------------------ + +function inverset(Probt, DF : double) : double; +var + z, W, tValue: double; +begin + // Returns the t value corresponding to a two-tailed t test probability. + z := inversez(Probt); + W := z * ((8.0 * DF + 3.0) / (1.0 + 8.0 * DF)); + tValue := sqrt(DF * (exp(W * W / DF) - 1.0)); + inverset := tValue; +end; +//--------------------------------------------------------------------- + +function inversechi(p : double; k : integer) : double; +var + a1, w, z : double; +begin + z := inversez(p); + a1 := 2.0 / ( 9.0 * k); + w := 1.0 - a1 + z * sqrt(a1); + Result := (k * w * w * w); +end; +//--------------------------------------------------------------------- + +function STUDENT(q,v,r : real) : real; + +{ Yields the probability of a sample value of Q or larger from a population + with r means and degrees of freedom for the mean square error of v.} +var + probq : real; +// done : boolean; + ifault : integer; +// ch : char; + +function alnorm(x: real; upper: boolean): real; +{ algorithm AS 66 from Applied Statistics, 1973, Vol. 22, No.3, pg.424-427 } + +var + ltone, utzero, zero, half, one, con, z, y : real; + up : boolean; + altemp: real; + +begin + // altemp := 0.0; + ltone := 7.0; + utzero := 18.66; + zero := 0.0; + half := 0.5; + one := 1.0; + con := 1.28; + up := upper; + z := x; + if z < zero then + begin + up := not up; + z := -z; + end; + if (z <= ltone) or (up) and (z <= utzero) then + begin + y := half * z * z; + if z > con then + begin + altemp := 0.398942280385 * exp(-y) / + (z - 3.8052e-8 + 1.00000615302 / + (z + 3.98064794e-4 + 1.98615381364 / + (z - 0.151679116635 + 5.29330324926 / + (z + 4.8385912808 - 15.1508972451 / + (z + 0.742380924027 + 30.789933034 / + (z + 3.99019417011)))))); + end + else altemp := half - z * (0.398942280444 - 0.399903438504 * y / + (y + 5.75885480458 - 29.8213557808 / + (y + 2.62433121679 + 48.6959930692 / + (y + 5.92885724438)))); + end + else altemp := zero; + if not up then altemp := one - altemp; + alnorm := altemp; +end; +//---------------------------------------------------------------------------- + +procedure prtrng(q, v, r : real; var ifault : integer; var sumprob : real); + +{ algorithm as 190 appl. Statistics, 1983, Vol.32, No.2 + evaluates the probability from 0 to q for a studentized range having + v degrees of freedom and r samples. } + +label 21, 22, 25; + +var + pcutj, pcutk, step, vmax, zero, fifth, half, one, two : real; + cv1, cv2, cvmax : real; + vw, qw : array[1..30] of real; + cv : array[1..4] of real; + jmin, jmax, kmin, kmax : integer; + g, gmid, r1, c, h, v2, gstep, gk, pk, pk1, pk2, w0, pz : real; + x, hj, ehj, pj : real; + j, jj, jump, k : integer; + +begin + sumprob := 0.0; + pcutj := 0.00003; pcutk := 0.0001; step := 0.45; vmax := 120.0; + zero := 0.0; fifth := 0.2; half := 0.5; one := 1.0; two := 2.0; + cv1 := 0.193064705; cv2 := 0.293525326; cvmax := 0.39894228; + cv[1] := 0.318309886; cv[2] := -0.268132716e-2; + cv[3] := 0.347222222e-2; cv[4] := 0.833333333e-1; + jmin := 3; jmax := 13; kmin := 7; kmax := 15; + { check initial values } +// prtrng := zero; + ifault := 0; + if (v < one) or (r < two) then ifault := 1; + if (q >= zero) and (ifault = 0) then + begin { main body of function } + g := step * realraise(r,-fifth); + gmid := half * ln(r); + r1 := r - one; + c := ln(r * g * cvmax); + if c <= vmax then + begin + h := step * realraise(v,-half); + v2 := v * half; + if v = one then c := cv1; + if v = two then c := cv2; + if NOT ((v = one) or (v = two)) then c := sqrt(v2) * cv[1] / + (one + ((cv[2] / v2 + cv[3]) / v2 + cv[4]) / v2); + c := ln(c * r * g * h); + end; + { compute integral. + Given a row k, the procedure starts at the midpoint and works outward + (index j) in calculating the probability at nodes symetric about the + midpoint. The rows (index k) are also processed outwards symmetrically + about the midpoint. The center row is unpaired. } + gstep := g; + qw[1] := -one; + qw[jmax + 1] := -one; + pk1 := one; + pk2 := one; + for k := 1 to kmax do + begin + gstep := gstep - g; +21: gstep := -gstep; + gk := gmid + gstep; + pk := zero; + if (pk2 > pcutk) or (k <= kmin) then + begin + w0 := c - gk * gk * half; + pz := alnorm(gk,TRUE); + x := alnorm(gk - q,TRUE) - pz; + if (x > zero) then pk := exp(w0 + r1 * ln(x)); + if v <= vmax then + begin + jump := -jmax; + 22: jump := jump + jmax; + for j := 1 to jmax do + begin + jj := j + jump; + if (qw[jj] <= zero) then + begin + hj := h * j; + if j < jmax then qw[jj + 1] := -one; + ehj := exp(hj); + qw[jj] := q * ehj; + vw[jj] := v * (hj + half - ehj * ehj * half); + end; + pj := zero; + x := alnorm(gk - qw[jj],TRUE) - pz; + if x > zero then pj := exp(w0 + vw[jj] + r1 * ln(x)); + pk := pk + pj; + if pj <= pcutj then + begin + if(jj > jmin) or (k > kmin) then goto 25; + end; + end; { for j := 1 to jmax } + 25: h := -h; + if h < zero then goto 22; + end; { if v less than or equal vmax } + end; { if pk2 > pcutk or k <= kmin } + sumprob := sumprob + pk; + if (k <= kmin) or (pk > pcutk) or (pk1 > pcutk) then + begin + pk2 := pk1; + pk1 := pk; + if gstep > zero then goto 21; + end; + end; { for k := 1 to kmax } + end; { main body of function } +// prtrng := sumprob; +end; { of function } + +begin { program main body } + ifault := 0; + probq := 0.0; + prtrng(q,v,r,ifault,probq); + probq := 1.0 - probq; + { if ifault = 1 then ShowMessage('ERROR! Fault in calculating Student Q.');} + student := probq; + end; { end of student function } +//------------------------------------------------------------------- + +function realraise(base,power : double ): double; +begin + if power = 0 then realraise := 1.0 + else if power < 0 then realraise := 1 / realraise(base,-power) + else realraise := exp(power * ln(base)) +end; (* End of realraise *) +//------------------------------------------------------------------- + +function fpercentpoint(p : real; k1,k2 : integer) : real; + +(* Calculates the inverse F distribution function based on k1 and k2 *) +(* degrees of freedom. Uses function lngamma, betaratio and the *) +(* inversebetaratio routines. *) + +var h1,h2 : real; (* half degrees of freedom k1, k2 *) + lnbeta : real; (* log of complete beta function with params h1 and h2 *) + ratio : real; (* beta ratio *) + x : real; (* inverse beta ratio *) + +begin + h1 := 0.5 * k2; + h2 := 0.5 * k1; + ratio := 1 - p; + lnbeta := lngamma(h1) + lngamma(h2) - lngamma(h1 + h2); + x := inversebetaratio(ratio,h1,h2,lnbeta); + fpercentpoint := k2 * (1 - x) / (k1 * x) +end; (* of fpercentpoint *) +//------------------------------------------------------------------- + +function lngamma(w : real) : real; + +(* Calculates the logarithm of the gamma function. w must be such that *) +(* 2*w is an integer > 0. *) + +const a = 0.57236494; (* ln(sqrt(pi)) *) + +var sum:real; (* a temporary store for summation of values *) + +begin + sum := 0; + w := w-1; + while w > 0.0 do + begin + sum := sum + ln(w); + w := w - 1 + end; (* of summation loop *) + if w < 0.0 + then lngamma := sum + a (* note!!! is something is missing here? *) + else lngamma := sum +end; (* of lngamma *) +//------------------------------------------------------------------- + +function betaratio(x,a,b,lnbeta : real) : real; + +(* calculates the incomplete beta function ratio with parameters a *) +(* and b. LnBeta is the logarithm of the complete beta function with *) +(* parameters a and b. *) + +const error = 1.0E-7; + +var c : real; (* c = a + b *) + factor1,factor2,factor3 : real; (* factors multiplying terms in series *) + i,j : integer; (* counters *) + sum : real; (* current sum of series *) + temp : real; (* temporary store for exchanges *) + term : real; (* term of series *) + xlow : boolean; (* status of x which determines the end from which the *) + (* series is evaluated *) + // ylow : real; (* adjusted argument *) + y : real; + +begin + if (x=0) or (x=1) + then + sum := x + else begin + c := a + b; + if a < c*x + then begin + xlow := true; + y := x; + x := 1 - x; + temp := a; + a := b; + b := temp + end + else begin + xlow := false; + y := 1 - x; + end; + term := 1; + j := 0; + sum := 1; + i := trunc(b + c * y) + 1; + factor1 := x/y; + repeat + j := j + 1; + i := i - 1; + if i >= 0 + then begin + factor2 := b - j; + if i = 0 then factor2 := x; + end; + if abs(a+j) < 1.0e-6 then + begin + betaratio := sum; + exit; + end; + term := term*factor2*factor1/(a+j); + sum := sum + term; + until (abs(term) <= sum) and (abs(term) <= error*sum); + factor3 := exp(a*ln(x) + (b-1)*ln(y) - lnbeta); + sum := sum*factor3/a; + if xlow + then sum := 1 - sum; + end; + betaratio := sum; +end; (* of betaratio *) +//------------------------------------------------------------------- + +function inversebetaratio(ratio,a,b,lnbeta : real) : real; + +(* Calculates the inverse of the incomplete beta function ratio with *) +(* parameters a and b. LnBeta is the logarithm of the complete beta *) +(* function with parameters a and b. Uses function betaratio. *) + +const error = 1.0E-7; + +var +// c: real; (* c = a + b *) + largeratio : boolean; + temp1,temp2,temp3,temp4 : real; (* temporary variables *) + x,x1 : real; (* successive estimates of inverse ratio *) + y : real; (* adjustment during newton iteration *) + +begin + if (ratio = 0) or (ratio = 1) + then + x := ratio + else begin + largeratio := false; + if ratio > 0.5 + then begin + largeratio := true; + ratio := 1 - ratio; + temp1 := a; + b := a; + a := temp1 + end; +// c := a + b; + (* calcuates initial estimate for x *) + temp1 := sqrt(-ln(ratio*ratio)); + temp2 := 1.0 + temp1*(0.99229 + 0.04481*temp1); + temp2 := temp1 - (2.30753 + 0.27061*temp1)/temp2; + if (a > 1) and (b > 1) + then begin + temp1 := (temp2*temp2 - 3.0)/6.0; + temp3 := 1.0/(a + a -1.0); + temp4 := 1.0/ (b + b - 1.0); + x1 := 2.0 /(temp3 + temp4); + x := temp1 + 5.0/6.0 - 2.0/(3.0*x1); + x := temp2*sqrt(x1 + temp1)/x1 - x*(temp4 - temp3); + x := a/(a + b*exp(x + x)) + end + else begin + temp1 := b + b; + temp3 := 1.0/(9.0*b); + temp3 := 1.0 - temp3 + temp2*sqrt(temp3); + temp3 := temp1*temp3*temp3*temp3; + if temp3 > 0 + then begin + temp3 := (4.0*a + temp1 - 2.0)/temp3; + if temp3 > 1 then x := 1.0-2.0/(1 + temp3) + else x := exp((ln(ratio*a) + lnbeta)/a) + end + else x := 1.0 - exp((ln((1-ratio)*b) + lnbeta)/b); + end; + + (* Newton iteration *) + repeat + y := betaratio(x,a,b,lnbeta); + y := (y-ratio)*exp((1-a)*ln(x)+(1-b)*ln(1-x)+lnbeta); + temp4 := y; + x1 := x - y; + while (x1 <= 0) or (x1 >= 1) do + begin + temp4 := temp4/2; + x1 := x - temp4 + end; + x := x1; + until abs(y) < error; + if largeratio then x := 1 - x; + end; + inversebetaratio := x +end; (* of inversebetaratio *) +//------------------------------------------------------------------- + +function ProdSums(N, A : double) : double; +var + Total, i : double; +begin + Total := 1.0; + i := A; + while i <= N do + begin + Total := Total * i; + i := i + 1.0; + end; + Result := Total; +end; +//------------------------------------------------------------------- + +function combos(X, N : double) : double; +var + Y, numerator, denominator : double; +begin + Y := N - X; + if Y > X then + begin + numerator := ProdSums(N, Y + 1); + denominator := ProdSums(X, 1); + end + else begin + numerator := ProdSums(N, X + 1); + denominator := ProdSums(Y, 1); + end; + Result := numerator / denominator; +end; +//------------------------------------------------------------------- + +function ordinate(z : double) : double; +var pi : double; +begin + pi := 3.14159; + Result := (1.0 / sqrt(2.0 * pi)) * (1.0 / exp(z * z / 2.0)); +end; // End ord function +//------------------------------------------------------------------- + +procedure Rank(v1col : integer; VAR Values : DblDyneVec); +// calculates the ranks for values stored in the data grid in column v1col +var + pcntiles, CatValues : DblDyneVec; + freq : IntDyneVec; + i, j, nocats : integer; + Temp, cumfreq, upper, lower : double; + +begin + SetLength(freq, NoCases); + SetLength(pcntiles, NoCases); + SetLength(CatValues, NoCases); + + // get values to be sorted into values vector + for i := 1 to NoCases do + Values[i-1] := StrToFloat(OS3MainFrm.DataGrid.Cells[v1col,i]); + + // sort the values + for i := 1 to NoCases - 1 do //order from high to low + begin + for j := i + 1 to NoCases do + begin + if (Values[i-1] < Values[j-1]) then // swap + begin + Temp := Values[i-1]; + Values[i-1] := Values[j-1]; + Values[j-1] := Temp; + end; + end; + end; + + // now get no. of unique values and frequency of each + nocats := 1; + for i := 1 to NoCases do freq[i-1] := 0; + Temp := Values[0]; + CatValues[0] := Temp; + for i := 1 to NoCases do + begin + if (Temp = Values[i-1]) then freq[nocats-1] := freq[nocats-1] + 1 + else // new value + begin + nocats := nocats + 1; + freq[nocats-1] := freq[nocats-1] + 1; + Temp := Values[i-1]; + CatValues[nocats-1] := Temp; + end; + end; + + // get ranks + cumfreq := 0.0; + for i := 1 to nocats do + begin + upper := NoCases-cumfreq; + cumfreq := cumfreq + freq[i-1]; + lower := NoCases - cumfreq + 1; + pcntiles[i-1] := (upper - lower) / 2.0 + lower; + end; + + // convert original values to their corresponding ranks + for i := 1 to NoCases do + begin + Temp := StrToFloat(OS3MainFrm.DataGrid.Cells[v1col,i]); + for j := 1 to nocats do + begin + if (Temp = CatValues[j-1]) then Values[i-1] := pcntiles[j-1]; + end; + end; + + // clean up the heap + CatValues := nil; + pcntiles := nil; + freq := nil; +end; +//-------------------------------------------------------------------- + +procedure PRank(v1col: integer; var Values: DblDyneVec); +// computes the percentile ranks of values stored in the data grid +// at column v1col +var + pcntiles, cumfm, CatValues: DblDyneVec; + freq, cumf: IntDyneVec; + Temp: double; + i, j, nocats, ncases: integer; +begin + SetLength(freq, NoCases); + SetLength(pcntiles, NoCases); + SetLength(cumf, NoCases); + SetLength(cumfm, NoCases); + SetLength(CatValues, NoCases); + ncases := 0; + + // get values to be sorted into values vector + for i := 1 to NoCases do + begin + if not ValidValue(i,v1col) then continue; + ncases := ncases + 1; + Values[ncases-1] := StrToFloat(OS3MainFrm.DataGrid.Cells[v1col,i]); + end; + + // sort the values + for i := 1 to ncases - 1 do //order from low to high + begin + for j := i + 1 to ncases do + begin + if (Values[i-1] > Values[j-1]) then // swap + begin + Temp := Values[i-1]; + Values[i-1] := Values[j-1]; + Values[j-1] := Temp; + end; + end; + end; + + // now get no. of unique values and frequency of each + nocats := 1; + for i := 1 to ncases do freq[i-1] := 0; + Temp := Values[0]; + CatValues[0] := Temp; + for i := 1 to ncases do + begin + if (Temp = Values[i-1])then + freq[nocats-1] := freq[nocats-1] + 1 + else // new value + begin + nocats := nocats + 1; + freq[nocats-1] := freq[nocats-1] + 1; + Temp := Values[i-1]; + CatValues[nocats-1] := Temp; + end; + end; + + // now get cumulative frequencies + cumf[0] := freq[0]; + for i := 1 to nocats-1 do + cumf[i] := freq[i] + cumf[i-1]; + + // get cumulative frequences to midpoints and percentile ranks + cumfm[0] := freq[0] / 2.0; + pcntiles[0] := (cumf[0] / 2.0) / ncases; + for i := 1 to nocats-1 do + begin + cumfm[i] := (freq[i] / 2.0) + cumf[i-1]; + pcntiles[i] := cumfm[i] / ncases; + end; + + OutPutFrm.AddLine('PERCENTILE RANKS'); + OutPutFrm.AddLine('Score Value Frequency Cum.Freq. Percentile Rank'); + OutPutFrm.AddLine('----------- --------- --------- ---------------'); +// OutPutFrm.AddLine('___________ __________ __________ ______________'); + for i := 1 to nocats do + OutputFrm.AddLine(' %10.3f %8d %8d %12.2f%%', [CatValues[i-1], freq[i-1], cumf[i-1], pcntiles[i-1]*100.0]); + OutPutFrm.AddLine(''); + + // convert original values to their corresponding percentile ranks + for i := 1 to ncases do + begin + Temp := StrToFloat(OS3MainFrm.DataGrid.Cells[v1col,i]); + for j := 1 to nocats do + if (Temp = CatValues[j-1]) then Values[i-1] := pcntiles[j-1]; + end; + + // clean up the heap + CatValues := nil; + cumfm := nil; + cumf := nil; + pcntiles := nil; + freq := nil; +end; +//-------------------------------------------------------------------- + +function UniStats(N : integer; VAR X : DblDyneVec; VAR z : DblDyneVec; + VAR Mean : double; VAR variance : double; VAR SD : double; + VAR Skew : double; VAR Kurtosis : double; VAR SEmean : double; + VAR SESkew : double; VAR SEkurtosis : double; VAR min : double; + VAR max : double; VAR Range : double; VAR MissValue : string) : + integer; +VAR + NoGood : integer; // No. of good cases returned by the function + i : integer; // index for loops + num, den, sum, M2, M3, M4, deviation, devsqr : double; + valuestr : string; + +begin + Mean := 0.0; + variance := 0.0; + SD := 0.0; + Skew := 0.0; + Kurtosis := 0.0; + SEmean := 0.0; + SESkew := 0.0; + SEKurtosis := 0.0; + min := 1.0e20; + max := -1.0e20; + range := 0.0; + NoGood := 0; + sum := 0.0; + M2 := 0.0; + M3 := 0.0; + M4 := 0.0; + + for i := 0 to N-1 do + begin + ValueStr := FloatToStr(X[i]); + if Trim(MissValue) = ValueStr then continue; + NoGood := NoGood + 1; + sum := sum + X[i]; + variance := variance + (X[i] * X[i]); + if X[i] < min then min := X[i]; + if X[i] > max then max := X[i]; + end; + + if NoGood > 0 then + begin + Mean := sum / NoGood; + range := max - min; + end; + + if NoGood > 1 then + begin + variance := variance - (sum * sum) / NoGood; + variance := variance / (NoGood - 1); + SD := sqrt(variance); + SEmean := sqrt(variance / NoGood); + for i := 0 to N-1 do + begin + ValueStr := FloatToStr(X[i]); + if Trim(MissValue) = ValueStr then continue; + deviation := X[i] - Mean; + z[i] := deviation / SD; + devsqr := deviation * deviation; + M2 := M2 + devsqr; + M3 := M3 + (deviation * devsqr); + M4 := M4 + (devsqr * devsqr); + end; + end; + if NoGood > 3 then + begin + Skew := (NoGood * M3) / ((NoGood - 1) * (NoGood - 2) * SD * variance); + num := 6.0 * NoGood * (NoGood - 1); + den := (NoGood - 2) * (NoGood + 1) * (NoGood + 3); + SESkew := sqrt(num / den); + Kurtosis := (NoGood * (NoGood + 1) * M4) - (3.0 * M2 * M2 * (NoGood - 1)); + Kurtosis := Kurtosis / ((NoGood - 1) * (NoGood - 2) * (NoGood - 3) * + (variance * variance)); + SeKurtosis := sqrt((4.0 * (NoGood * NoGood - 1) * (SESkew * SESkew)) / + ((NoGood - 3) * (NoGood + 5))); + end; + Result := NoGood; +end; +//------------------------------------------------------------------- + +function WholeValue(value : double) : double; + { split a value into the whole and fractional parts} +VAR + whole : double; +begin + whole := Floor(value); + Result := whole; +end; +//--------------------------------------------------------------------------- +function FractionValue(value : double) : double; + { split a value into the whole and fractional parts } +VAR + fraction : double; +begin + fraction := value - Floor(value); + Result := fraction; +end; +//--------------------------------------------------------------------------- + +Function Quartiles(TypeQ : integer; pcntile : double; N : integer; + VAR values : DblDyneVec) : double; +VAR + whole, fraction, Myresult, np, avalue, avalue1 : double; + subscript : integer; +begin +{ for i := 0 to N - 1 do // this is for debugging + begin + outline := format('Value = %8.3f',[values[i]]); + OutPutFrm.RichEdit.Lines.Add(outline); + end; + OutPutFrm.ShowModal; + OutPutFrm.RichEdit.Clear; } + case TypeQ of + 1 : np := pcntile * N; + 2 : np := pcntile * (N + 1); + 3 : np := pcntile * N; + 4 : np := pcntile * N; + 5 : np := pcntile * (N - 1); + 6 : np := pcntile * N + 0.5; + 7 : np := pcntile * (N + 1); + 8 : np := pcntile * (N + 1); + end; + whole := WholeValue(np); + fraction := FractionValue(np); + subscript := Trunc(whole) - 1; + avalue := values[subscript]; + avalue1 := values[subscript + 1]; + case TypeQ of + 1 : Myresult := ((1.0 - fraction) * values[subscript]) + + fraction * values[subscript + 1]; + 2 : Myresult := ((1.0 - fraction) * avalue) + + fraction * avalue1; // values[subscript + 1]; + 3 : if (fraction = 0.0) then Myresult := values[subscript] + else Myresult := values[subscript + 1]; + 4 : if (fraction = 0.0) then Myresult := 0.5 * (values[subscript] + values[subscript + 1]) + else Myresult := values[subscript + 1]; + 5 : if (fraction = 0.0) then Myresult := values[subscript + 1] + else Myresult := values[subscript + 1] + fraction * (values[subscript + 2] - + values[subscript + 1]); + 6 : Myresult := values[subscript]; + 7 : if (fraction = 0.0) then Myresult := values[subscript] + else Myresult := fraction * values[subscript] + + (1.0 - fraction) * values[subscript + 1]; + 8 : begin + if (fraction = 0.0) then Myresult := values[subscript]; + if (fraction = 0.5) then Myresult := 0.5 * (values[subscript] + values[subscript + 1]); + if (fraction < 0.5) then Myresult := values[subscript]; + if (fraction > 0.5) then Myresult := values[subscript + 1]; + end; + end; + Result := Myresult; +end; + +function KolmogorovProb(z : double) : double; +VAR + fj : array[0..3] of double; // = {-2,-8,-18,-32}; + r : array[0..4] of double; + u : double; + p, V : double; + j, Maxj : integer; +const + w = 2.50662827; + // c1 - -pi**2/8, c2 = 9*c1, c3 = 25*c1 + c1 = -1.2337005501361697; + c2 = -11.103304951225528; + c3 = -30.842513753404244; + + + // Calculates the Kolmogorov distribution function, + // which gives the probability that Kolmogorov's test statistic will exceed + // the value z assuming the null hypothesis. This gives a very powerful + // test for comparing two one-dimensional distributions. + // see, for example, Eadie et al, "statistocal Methods in Experimental + // Physics', pp 269-270). + // + // This function returns the confidence level for the null hypothesis, where: + // z = dn*sqrt(n), and + // dn is the maximum deviation between a hypothetical distribution + // function and an experimental distribution with + // n events + // + // NOTE: To compare two experimental distributions with m and n events, + // use z = sqrt(m*n/(m+n))*dn + // + // Accuracy: The function is far too accurate for any imaginable application. + // Probabilities less than 10^-15 are returned as zero. + // However, remember that the formula is only valid for "large" n. + // Theta function inversion formula is used for z <= 1 + // + // This function was translated by Rene Brun from PROBKL in CERNLIB. + +begin + u := Abs(z); + fj[0] := -2; + fj[1] := -8; + fj[2] := -18; + fj[3] := -32; + if (u < 0.2) then p := 1 + else if (u < 0.755) then + begin + v := 1./(u*u); + p := 1 - w * (Exp(c1 * v) + Exp(c2 * v) + Exp(c3 * v)) / u; + end + else if (u < 6.8116) then + begin + r[1] := 0; + r[2] := 0; + r[3] := 0; + v := u * u; + maxj := round(max(1,(3. / u))); + for j := 0 to maxj -1 do r[j] := Exp(fj[j] * v); + p := 2 * (r[0] - r[1] + r[2] - r[3]); + end + else p := 0; + result := p; +end; + +function KolmogorovTest(na : integer; VAR a : DblDyneVec; nb : integer; + VAR b : DblDyneVec; option : String) : double; +VAR + prob : double; + opt : string; + rna : double; // = na; + rnb : double; // = nb; + sa : double; // = 1./rna; + sb : double; // = 1./rnb; + rdiff, rdmax, x, z : double; + i, ia, ib : integer; + ok : boolean; + bugstr : string; +begin +// Statistical test whether two one-dimensional sets of points are compatible +// with coming from the same parent distribution, using the Kolmogorov test. +// That is, it is used to compare two experimental distributions of unbinned data. +// +// Input: +// a,b: One-dimensional arrays of length na, nb, respectively. +// The elements of a and b must be given in ascending order. +// option is a character string to specify options +// "D" Put out a line of "Debug" printout +// "M" Return the Maximum Kolmogorov distance instead of prob +// +// Output: +// The returned value prob is a calculated confidence level which gives a +// statistical test for compatibility of a and b. +// Values of prob close to zero are taken as indicating a small probability +// of compatibility. For two point sets drawn randomly from the same parent +// distribution, the value of prob should be uniformly distributed between +// zero and one. +// in case of error the function return -1 +// If the 2 sets have a different number of points, the minimum of +// the two sets is used. +// +// Method: +// The Kolmogorov test is used. The test statistic is the maximum deviation +// between the two integrated distribution functions, multiplied by the +// normalizing factor (rdmax*sqrt(na*nb/(na+nb)). +// +// Code adapted by Rene Brun from CERNLIB routine TKOLMO (Fred James) +// (W.T. Eadie, D. Drijard, F.E. James, M. Roos and B. Sadoulet, +// Statistical Methods in Experimental Physics, (North-Holland, +// Amsterdam 1971) 269-271) +// +// Method Improvement by Jason A Detwiler (JADetwiler@lbl.gov) +// ----------------------------------------------------------- +// The nuts-and-bolts of the TMath::KolmogorovTest() algorithm is a for-loop +// over the two sorted arrays a and b representing empirical distribution +// functions. The for-loop handles 3 cases: when the next points to be +// evaluated satisfy a>b, a na) then + begin + ok := TRUE; + break; + end; + end + else if (a[ia-1] > b[ib-1]) then + begin + rdiff := rdiff + sb; + ib := ib + 1; + if (ib > nb) then + begin + ok := TRUE; + break; + end; + end + else + begin + x := a[ia-1]; + while((a[ia-1] = x) and (ia <= na)) do + begin + rdiff := rdiff - sa; + ia := ia + 1; + end; + while ((b[ib-1] = x) and (ib <= nb)) do + begin + rdiff := rdiff + sb; + ib := ib + 1; + end; + if (ia > na) then + begin + ok := TRUE; + break; + end; + if (ib > nb) then + begin + ok := TRUE; + break; + end; + end; + rdmax := Max(rdmax,Abs(rdiff)); + end; +// Should never terminate this loop with ok = kFALSE! + + if (ok) then + begin + rdmax := Max(rdmax,Abs(rdiff)); + z := rdmax * Sqrt(rna * rnb / (rna + rnb)); + prob := KolmogorovProb(z); + end; + // debug printout + if (opt = 'D') then + begin + bugstr := format(' Kolmogorov Probability = %g, Max Dist = %g',[prob,rdmax]); + OutPutFrm.RichEdit.Lines.Add(bugstr); + end; + if(opt = 'M') then result := rdmax + else result := prob; +end; + + +procedure poisson_cdf ( x : integer; a : double; VAR cdf : double ); +VAR + i : integer; + last, new1, sum2 : double; +begin +// +//******************************************************************************* +// +//// POISSON_CDF evaluates the Poisson CDF. +// +// +// Definition: +// +// CDF(X,A) is the probability that the number of events observed +// in a unit time period will be no greater than X, given that the +// expected number of events in a unit time period is A. +// +// Modified: +// +// 28 January 1999 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, integer X, the argument of the CDF. +// X >= 0. +// +// Input, real A, the parameter of the PDF. +// 0.0E+00 < A. +// +// Output, real CDF, the value of the CDF. +// + if ( x < 0 ) then cdf := 0.0E+00 + else + begin + new1 := exp ( - a ); + sum2 := new1; + for i := 1 to x do + begin + last := new1; + new1 := last * a / i ; + sum2 := sum2 + new1; + end; + cdf := sum2; + end; +end; + +procedure poisson_cdf_values (VAR n : integer; VAR a : double; VAR x : integer; + VAR fx : double ); +VAR + avec : DblDyneVec; + fxvec : DblDyneVec; + xvec : IntDyneVec; +begin + SetLength(avec,21); + SetLength(fxvec,21); + SetLength(xvec,21); + avec[0] := 0.02e0; + avec[1] := 0.10e0; + avec[2] := 0.10e0; + avec[3] := 0.50e0; + avec[4] := 0.50e0; + avec[5] := 0.50e0; + avec[6] := 1.00e0; + avec[7] := 1.00e0; + avec[8] := 1.00e0; + avec[9] := 1.00e0; + avec[10] := 2.00e0; + avec[11] := 2.00e0; + avec[12] := 2.00e0; + avec[13] := 2.00e0; + avec[14] := 5.00E+00; + avec[15] := 5.00E+00; + avec[16] := 5.00E+00; + avec[17] := 5.00E+00; + avec[18] := 5.00E+00; + avec[19] := 5.00E+00; + avec[20] := 5.00E+00; + fxvec[0] := 0.980E+00; + fxvec[1] := 0.905E+00; + fxvec[2] := 0.995E+00; + fxvec[3] := 0.607E+00; + fxvec[4] := 0.910E+00; + fxvec[5] := 0.986E+00; + fxvec[6] := 0.368E+00; + fxvec[7] := 0.736E+00; + fxvec[8] := 0.920E+00; + fxvec[9] := 0.981E+00; + fxvec[10] := 0.135E+00; + fxvec[11] := 0.406E+00; + fxvec[12] := 0.677E+00; + fxvec[13] := 0.857E+00; + fxvec[14] := 0.007E+00; + fxvec[15] := 0.040E+00; + fxvec[16] := 0.125E+00; + fxvec[17] := 0.265E+00; + fxvec[18] := 0.441E+00; + fxvec[19] := 0.616E+00; + fxvec[20] := 0.762E+00; + xvec[0] := 0; + xvec[1] := 0; + xvec[2] := 1; + xvec[3] := 0; + xvec[4] := 1; + xvec[5] := 2; + xvec[6] := 0; + xvec[7] := 1; + xvec[8] := 2; + xvec[9] := 3; + xvec[10] := 0; + xvec[11] := 1; + xvec[12] := 2; + xvec[13] := 3; + xvec[14] := 0; + xvec[15] := 1; + xvec[16] := 2; + xvec[17] := 3; + xvec[18] := 4; + xvec[19] := 5; + xvec[20] := 6; + +// +//******************************************************************************* +// +//// POISSON_CDF_VALUES returns some values of the Poisson CDF. +// +// +// Discussion: +// +// CDF(X)(A) is the probability of at most X successes in unit time, +// given that the expected mean number of successes is A. +// +// Modified: +// +// 28 May 2001 +// +// Reference: +// +// Milton Abramowitz and Irene Stegun, +// Handbook of Mathematical Functions, +// US Department of Commerce, 1964. +// +// Daniel Zwillinger, +// CRC Standard Mathematical Tables and Formulae, +// 30th Edition, CRC Press, 1996, pages 653-658. +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input/output, integer N. +// On input, if N is 0, the first test data is returned, and N is set +// to the index of the test data. On each subsequent call, N is +// incremented and that test data is returned. When there is no more +// test data, N is set to 0. +// +// Output, real A, integer X, the arguments of the function. +// +// Output, real FX, the value of the function. +// +// + if ( n < 0 ) then n := 0; + n := n + 1; + if ( n > 21 ) then + begin + n := 0; + a := 0.0; + x := 0; + fx := 0.0E+00; + exit; + end; + + a := avec[n]; + x := xvec[n]; + fx := fxvec[n]; + xvec := nil; + fxvec := nil; + avec := nil; +end; + +procedure poisson_cdf_inv (VAR cdf : double; VAR a : double; VAR x : integer ); +VAR + i, xmax : integer; + last, new1, sum2, sumold : double; +begin +// +//******************************************************************************* +// +//// POISSON_CDF_INV inverts the Poisson CDF. +// +// +// Modified: +// +// 08 December 1999 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, real CDF, a value of the CDF. +// 0 <= CDF < 1. +// +// Input, real A, the parameter of the PDF. +// 0.0E+00 < A. +// +// Output, integer X, the corresponding argument. +// +// Now simply start at X = 0, and find the first value for which +// CDF(X-1) <= CDF <= CDF(X). +// + xmax := 100; + sum2 := 0.0E+00; + for i := 0 to xmax do + begin + sumold := sum2; + if ( i = 0 ) then + begin + new1 := exp ( - a ); + sum2 := new1; + end + else + begin + last := new1; + new1 := last * a / i; + sum2 := sum2 + new1; + end; + if (( sumold <= cdf) and (cdf <= sum2 )) then + begin + x := i; + exit; + end; + end; + ShowMessage('POISSON_SAMPLE - Warning. Exceeded XMAX = 100'); + x := xmax; +end; + + +procedure poisson_check ( a : double ); +begin +// +//******************************************************************************* +// +//// POISSON_CHECK checks the parameter of the Poisson PDF. +// +// +// Modified: +// +// 08 December 1999 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, real A, the parameter of the PDF. +// 0.0E+00 < A. +// + if ( a <= 0.0E+00 ) then + ShowMessage('POISSON_CHECK - Fatal error. A <= 0.'); +end; + +function factorial(x : integer) : longint; //integer; +VAR + decx : longint; // integer; + product : longint; //integer; +begin + decx := x; + product := 1; + while (decx > 0) do + begin + product := decx * product; + decx := decx - 1; + end; + result := product; +end; + + +procedure poisson_pdf ( x : integer; VAR a : double; VAR pdf : double ); +begin +// +//******************************************************************************* +// +//// POISSON_PDF evaluates the Poisson PDF. +// +// +// Formula: +// +// PDF(X)(A) = EXP ( - A ) * A**X / X// +// +// Discussion: +// +// PDF(X)(A) is the probability that the number of events observed +// in a unit time period will be X, given the expected number +// of events in a unit time. +// +// The parameter A is the expected number of events per unit time. +// +// The Poisson PDF is a discrete version of the Exponential PDF. +// +// The time interval between two Poisson events is a random +// variable with the Exponential PDF. +// +// Modified: +// +// 01 February 1999 +// +// Author: +// +// John Burkardt +// +// Parameters: +// +// Input, integer X, the argument of the PDF. +// 0 <= X +// +// Input, real A, the parameter of the PDF. +// 0.0E+00 < A. +// +// Output, real PDF, the value of the PDF. +// + if ( x < 0 ) then pdf := 0.0E+00 + else + pdf := exp ( - a ) * power(a,x) / factorial ( x ); +// pdf := exp ( - a ) * power(a,x) / exp(logfactorial( x )); +end; + +function DegToRad(Deg: Double): Double; +begin + Result := Deg * Pi / 180.0; +end; + +end. + diff --git a/applications/lazstats/source/units/globals.pas b/applications/lazstats/source/units/globals.pas new file mode 100644 index 000000000..58c8c6fdf --- /dev/null +++ b/applications/lazstats/source/units/globals.pas @@ -0,0 +1,95 @@ +unit Globals; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Graphics; + +const TOL = 0.0005; + +Type IntDyneVec = array of integer; + +Type DblDyneVec = array of double; + +Type BoolDyneVec = array of boolean; + +Type DblDyneMat = array of array of double; + +Type IntDyneMat = array of array of integer; + +Type DblDyneCube = array of array of array of double; + +Type IntDyneCube = array of array of array of integer; + +Type DblDyneQuad = array of array of array of array of double; + +Type IntDyneQuad = array of array of array of array of integer; + +Type StrDyneVec = array of string; + +Type StrDyneMat = array of array of string; + +Type CharDyneVec = array of char; + +type POINT3D = record + x, y, z : double; +end; + +Type POINTint = record + x, y : integer; +end; + +type + TFractionType = (ftPoint, ftComma); + TMissingValueCode = (mvcSpace, mvcPeriod, mvcZero, mvcNines); + TJustification = (jLeft, jCenter, jRight); + + TOptions = record + DefaultPath: string; + FractionType: TFractionType; + DefaultMiss: TMissingValueCode; + DefaultJust: TJustification; + end; + +var + NoCases : integer; + NoVariables : integer; + VarDefined : array[0..500] of boolean; + TempStream : TMemoryStream; + TempVarItm : TMemoryStream; + DictLoaded : boolean; + FilterOn : boolean; + FilterCol : integer; + OpenStatPath : string; + AItems : array[0..8] of string; + LoggedOn : boolean = false; + + Options: TOptions = ( + DefaultPath: ''; + FractionType: ftPoint; + DefaultMiss: mvcNines; + DefaultJust: jLeft + ); + + +const + FractionTypeChars: array[TFractionType] of char = ('.', ','); + MissingValueCodes: array[TMissingValueCode] of string = (' ', '.', '0', '99999'); + JustificationCodes: array[TJustification] of string[1] = ('L', 'C', 'R'); + + DEFAULT_CONFIDENCE_LEVEL_PERCENT = 95.0; + DEFAULT_ALPHA_LEVEL = 0.05; + DEFAULT_BETA_LEVEL = 0.20; + + DATA_COLORS: array[0..11] of TColor = ( + clMaroon, clRed, clBlue, clGreen, clNavy, clTeal, + clAqua, clLime, clFuchsia, clGray, clSilver, clOlive + ); + + +implementation + +end. + diff --git a/applications/lazstats/source/units/matrixlib.pas b/applications/lazstats/source/units/matrixlib.pas new file mode 100644 index 000000000..7c68cc139 --- /dev/null +++ b/applications/lazstats/source/units/matrixlib.pas @@ -0,0 +1,2436 @@ +unit MatrixLib; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Globals, DictionaryUnit, OutputUnit, Dialogs, + FunctionsLib, DataProcs, MainUnit; + +procedure GridDotProd(col1, col2: integer; var Product: double; var Ngood: integer); + +procedure GridXProd(NoSelected : integer; + {VAR} Selected : IntDyneVec; + {VAR} Product : DblDyneMat; + Augment : boolean; + VAR Ngood : integer); + +procedure GridCovar(NoSelected : integer; + {VAR} Selected : IntDyneVec; + {VAR} Covar : DblDyneMat; + {VAR} Means : DblDyneVec; + {VAR} Variances : DblDyneVec; + {VAR} StdDevs : DblDyneVec; + VAR errorcode : boolean; + VAR Ngood : integer); + +procedure Correlations(NoSelected : integer; + {VAR} Selected : IntDyneVec; + {VAR} Correlations : DblDyneMat; + {VAR} Means : DblDyneVec; + {VAR} Variances : DblDyneVec; + {VAR} StdDevs : DblDyneVec; + VAR errorcode : boolean; + VAR Ngood : integer); + +procedure MatAxB(var A, B, C: DblDyneMat; BRows, BCols, CRows, CCols: Integer; + var ErrorCode: boolean); + +procedure MatTrn(var A, B: DblDyneMat; BRows, BCols: Integer); + +procedure nonsymroots(a : DblDyneMat; nv : integer; + var nf : integer; c : real; + var v : DblDyneMat; var e : DblDyneVec; + var px : DblDyneVec; + var t : double; + var ev : double); + +PROCEDURE ludcmp(VAR a: DblDyneMat; n: integer; VAR indx: IntDyneVec; VAR d: double); + +procedure DETERM(VAR a : DblDyneMat; rows, cols : integer; VAR determ : double; + VAR errorcode : boolean); + +procedure EffectCode(GridCol, min, max : integer; + FactLetter : string; + VAR startcol : integer; + VAR endcol : integer; + VAR novectors : integer); + +procedure MReg(NoIndep : integer; + {VAR} IndepCols : IntDyneVec; + DepCol : integer; + {VAR} RowLabels : StrDyneVec; + {VAR} Means : DblDyneVec; + {VAR} Variances : DblDyneVec; + {VAR} StdDevs : DblDyneVec; + {VAR} BWeights : DblDyneVec; + {VAR} BetaWeights : DblDyneVec; + {VAR} BStdErrs : DblDyneVec; + {VAR} Bttests : DblDyneVec; + {VAR} tProbs : DblDyneVec; + VAR R2 : double; + VAR stderrest : double; + VAR NCases : integer; + VAR errorcode : boolean; + PrintAll : boolean); + +procedure MReg(NoIndep : integer; + {VAR} IndepCols : IntDyneVec; + DepCol : integer; + {VAR} RowLabels : StrDyneVec; + {VAR} Means : DblDyneVec; + {VAR} Variances : DblDyneVec; + {VAR} StdDevs : DblDyneVec; + {VAR} BWeights : DblDyneVec; + {VAR} BetaWeights : DblDyneVec; + {VAR} BStdErrs : DblDyneVec; + {VAR} Bttests : DblDyneVec; + {VAR} tProbs : DblDyneVec; + VAR R2 : double; + VAR stderrest : double; + VAR NCases : integer; + VAR errorcode : boolean; + PrintAll : boolean; + AReport: TStrings); + +procedure Dynnonsymroots(var a : DblDyneMat; nv : integer; + var nf : integer; c : real; + var v : DblDyneMat; var e : DblDyneVec; + var px : DblDyneVec; + var t : double; + var ev : double); + +function DynCorrelations(novars : integer; + VAR ColSelected : IntDyneVec; + VAR DataGrid : DblDyneMat; + VAR rmatrix : DblDyneMat; + VAR means : DblDyneVec; + VAR vars : DblDyneVec; + VAR stddevs : DblDyneVec; + NCases : integer; + ReturnType : integer) : integer; + +procedure Predict(VAR ColNoSelected : IntDyneVec; + NoVars : integer; + VAR IndepInverse : DblDyneMat; + VAR Means : DblDyneVec; + VAR StdDevs : DblDyneVec; + VAR BetaWeights : DblDyneVec; + StdErrEst : double; + VAR IndepIndex : IntDyneVec; + NoIndepVars : integer); + +procedure MReg2(NCases : integer; + NoVars : integer; + VAR NoIndepVars : integer; + VAR IndepIndex : IntDyneVec; + VAR corrs : DblDyneMat; + VAR IndepCorrs : DblDyneMat; + VAR RowLabels : StrDyneVec; + VAR R2 : double; + VAR BetaWeights : DblDyneVec; + VAR Means : DblDyneVec; + VAR Variances : DblDyneVec; + VAR errorcode : integer; + VAR StdErrEst : double; + VAR constant : double; + probout : double; + Printit : boolean; + TestOut : boolean; + PrintInv : boolean; + AReport: TStrings); + +procedure MATSUB(VAR a, b, c : DblDyneMat; + brows, bcols, crows, ccols : integer; VAR errorcode : boolean); + +procedure IntArrayPrint(mat : IntDyneMat; + rows, cols : integer; + ytitle : string; + RowLabels, ColLabels : StrDyneVec; + Title : string; + AReport: TStrings); + +procedure IntArrayPrint(mat : IntDyneMat; + rows, cols : integer; + ytitle : string; + RowLabels, ColLabels : StrDyneVec; + Title : string); + +procedure eigens(VAR a: DblDyneMat; Var d : DblDyneVec; n : integer); + +PROCEDURE tred2(VAR a: DblDyneMat; n: integer; VAR d,e: DblDyneVec); + +PROCEDURE tqli(VAR d,e: DblDyneVec; n: integer; VAR z: DblDyneMat); + +function SEVS(nv,nf : integer; + c : double; + var r : DblDyneMat; + VAR v : DblDyneMat; + VAR e : DblDyneVec; + var p : DblDyneVec; + VAR nd : integer) : integer ; + +function SCPF(VAR x,y : DblDyneMat; kx,ky,n,nd : integer) : double; + +procedure Mat_Print(var xmat: DblDyneMat; Rows,Cols: Integer; var Title: String; + var RowLabels, ColLabels: StrDyneVec; NCases: Integer); +procedure MatPrint(var xmat: DblDyneMat; Rows,Cols: Integer; var Title: String; + var RowLabels, ColLabels: StrDyneVec; NCases: Integer; AReport: TStrings); + +procedure DynVectorPrint(var AVector: DblDyneVec; NoVars: integer; + Title: string; var Labels: StrDyneVec; NCases: integer); overload; +procedure DynVectorPrint(var AVector: DblDyneVec; NoVars: integer; + Title: string; var Labels: StrDyneVec; NCases: integer; AReport: TStrings); overload; + +procedure scatplot(var x : DblDyneVec; + var y : DblDyneVec; + nocases : integer; + titlestr : string; + x_axis, y_axis : string; + x_min, x_max, y_min, y_max : double; + VAR VarLabels : StrDyneVec); + +procedure DynIntMatPrint(Mat: IntDyneMat; Rows, Cols: integer; YTitle: string; + RowLabels, ColLabels: StrDyneVec; Title: string); overload; +procedure DynIntMatPrint(Mat: IntDyneMat; Rows, Cols: integer; YTitle: string; + RowLabels, ColLabels: StrDyneVec; Title: string; AReport: TStrings); overload; + +procedure SymMatRoots(A : DblDyneMat; M : integer; VAR E : DblDyneVec; VAR V : DblDyneMat); +procedure matinv(a, vtimesw, v, w: DblDyneMat; n: integer); + +implementation + +procedure GridDotProd(col1, col2: integer; var Product: double; var Ngood: integer); +// Get the cross-product of two vectors +// col1 and col2 are grid columns of the main form's DataGrid +// Product is the vector product +// Ngood are the number of elements in the product not missing or filtered + +// wp: "vector product" -- misleading name because the procedure return the "dot" product. +// ==> Renamed from "GridVecProd" to "GridDotProd" +var + i: integer; + Selected: IntDyneVec; + X1, X2: double; +begin + SetLength(Selected,2); + Product := 0.0; + Selected[0] := col1; + Selected[1] := col2; + for i := 1 to NoCases do + begin + if not GoodRecord(i,2,Selected) then continue; + Ngood := Ngood + 1; + X1 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col1, i])); + X2 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col2, i])); + Product := Product + X1 * X2; + end; + Selected := nil; +end; +//------------------------------------------------------------------- + +procedure GridXProd(NoSelected : integer; + {VAR} Selected : IntDyneVec; + {VAR} Product : DblDyneMat; + Augment : boolean; + var Ngood : integer); +// Matrix product of a grid matrix and its transpose +// Product contains the cross-products matrix upon return +// Selected is a integer vector of grid columns of the vectors +// NoSelected is an integer of the number of grid vectors selected +// Ngood is the number of elements in a vector product not missing or filtered +// Augment is true if the augment matrix is to be obtained and is required +// to obtain means, variances, standard deviations in the correlation procedure +// and GridCovar procedure +var + i, j, k : integer; + Col1, Col2 : integer; + X1 : double; + Prod : double; + NoVars : integer; + N : double; + +begin + // initialize + N := 0.0; + NoVars := 0; + for i := 1 to NoSelected do + for j := 1 to NoSelected do + Product[i-1,j-1] := 0.0; + if Augment then + begin + NoVars := NoSelected + 1; + for i := 1 to NoVars do + begin + Product[i-1,NoVars-1] := 0.0; + Product[NoVars-1,i-1] := 0.0; + end; + end; + + // Do cross-products without augmentation + for i := 1 to NoSelected do // pre-matrix row (Grid transpose) + begin + for j := 1 to NoSelected do // post-matrix column (Grid) + begin + Ngood := 0; + Col1 := Selected[i-1]; + Col2 := Selected[j-1]; + GridDotProd(Col1,Col2,Prod, Ngood); + Product[i-1,j-1] := Prod; + end; + end; + + if Augment then // do last column and row for augmented matrix + begin + for j := 1 to NoSelected do + begin + Col1 := Selected[j-1]; + for k := 1 to NoCases do + begin + if not GoodRecord(k,NoSelected,Selected) then continue; + X1 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[Col1,k])); + Product[NoVars-1,j-1] := Product[NoVars-1,j-1] + X1; + Product[j-1,NoVars-1] := Product[j-1,NoVars-1] + X1; + end; + end; + for i := 1 to NoCases do // last cell of augmented matix + begin + if not GoodRecord(i,NoSelected,Selected) then continue; + N := N + 1.0; + end; + Product[NoVars-1,NoVars-1] := N; + Ngood := round(N); + end; +end; +//------------------------------------------------------------------- + +procedure GridCovar(NoSelected : integer; + {VAR} Selected : IntDyneVec; + {VAR} Covar : DblDyneMat; + {VAR} Means : DblDyneVec; + {VAR} Variances : DblDyneVec; + {VAR} StdDevs : DblDyneVec; + VAR errorcode : boolean; + VAR Ngood : integer); +// Obtains the variance/covariance matrix of variables in the grid +// NoSelected is the number of variables selected from the grid +// Selected is a vector of integers for the grid columns of selected variables +// Covar is the variance/covariance matrix returned +// Means, StdDevs, Variances are double vectors obtained from the augmented matrix +// errorcode is true if an error occurs due to 0 variance +// Ngood is the number of records in the cross-product of vectors +// This procedure calls the GridXProd procedure with augmentation true +// in order to obtain the means, variances and standard deviations +var + i, j: integer; + N: double; + Augment: boolean; +begin + // initialize + errorcode := false; + for i := 1 to NoSelected do + begin + Means[i-1] := 0.0; + Variances[i-1] := 0.0; + StdDevs[i-1] := 0.0; + end; + Augment := true; // augment to get intercept, means, variances, std.devs. + + // get cross-products + GridXProd(NoSelected,Selected,Covar,Augment,Ngood); + + // Get no. of records in cross-products + N := Ngood; + + // Sums of squares are in diagonal, cross-products in off-diagonal cells + // Sums of X's are in the augmented column + // Get means and standard deviations first + for i := 1 to NoSelected do + begin + Means[i-1] := Covar[i-1,NoSelected] / N; + Variances[i-1] := Covar[i-1,i-1] - (Sqr(Covar[i-1,NoSelected]) / N); + Variances[i-1] := Variances[i-1] / (N - 1.0); + if Variances[i-1] > 0.0 then + StdDevs[i-1] := sqrt(Variances[i-1]) + else + begin + StdDevs[i-1] := 0.0; + errorcode := true; + end; + end; + + // Now get covariances + for i := 1 to NoSelected do + begin + for j := 1 to NoSelected do + begin + Covar[i-1,j-1] := Covar[i-1,j-1] - ((Covar[i-1,NoSelected] * Covar[j-1,NoSelected]) / N); + Covar[i-1,j-1] := Covar[i-1,j-1] / (N - 1); + end; + end; +end; +//------------------------------------------------------------------- + +procedure Correlations(NoSelected : integer; + {VAR} Selected : IntDyneVec; + {VAR} Correlations : DblDyneMat; + {VAR} Means : DblDyneVec; + {VAR} Variances : DblDyneVec; + {VAR} StdDevs : DblDyneVec; + VAR errorcode : boolean; + VAR Ngood : integer); +// Obtains the correlation matrix among grid variables +// NoSelected is the no. of grid variables selected for analysis +// Selected is a vector of integers of the grid variable columns selected +// Correlations are returned in the Correlations matrix +// Means, Variances, StdDevs are returned as double vectors +// errorcode is true if a 0 variance is detected +// Ngood is the number cases that do not contain missing values or are filtered +// This procedure calls the GridCovar procedure +var + i, j : integer; + +begin + // get covariance matrix, means and standard deviations + GridCovar(NoSelected,Selected,Correlations,Means,Variances,StdDevs,errorcode, Ngood); + for i := 1 to NoSelected do + begin + for j := 1 to NoSelected do + begin + if (StdDevs[i-1] > 0.0) and (StdDevs[j-1] > 0.0) then + Correlations[i-1,j-1] := Correlations[i-1,j-1] / + (StdDevs[i-1] * StdDevs[j-1]) + else + begin + Correlations[i-1,j-1] := 0.0; + errorcode := true; + end; + end; + end; +end; +//------------------------------------------------------------------- + +// Product of matrix b times c with results returned in a +procedure MatAxB(var A, B, C: DblDyneMat; BRows, BCols, CRows, CCols: Integer; + var ErrorCode: boolean); +var + i, j, k: integer; +begin + ErrorCode := false; + if (BCols <> CRows) then + ErrorCode := true + else + begin + for i := 0 to BRows-1 do + begin + for j := 0 to CCols-1 do + begin + A[i,j] := 0.0; + for k := 0 to CRows-1 do + A[i,j] := A[i,j] + B[i,k] * C[k,j]; + end; + end; + end; +end; { of MATAxB } + +//------------------------------------------------------------------- + +// transpose the b matrix and return it in a +procedure MatTrn(var A, B: DblDyneMat; BRows, BCols : integer); +var + i, j: integer; +begin + for i := 0 to BRows-1 do + for j := 0 to BCols-1 do + A[j,i] := B[i,j]; +end; { of mattrn } +//------------------------------------------------------------------- + +procedure nonsymroots(a : DblDyneMat; nv : integer; + var nf : integer; c : real; + var v : DblDyneMat; var e : DblDyneVec; + var px : DblDyneVec; + var t : double; + var ev : double); +{ roots and vectors of a non symetric matrix. a is square matrix entered + and is destroyed in process. nv is number of variables (rows and columns ) + of a. nf is the number of factorsto be extracted - is output as the number + which exceeded c, the minimum eigenvalue to be extracted. v is the output + matrix of column vectors of loadings. e is the output vector of roots. px + is the percentages of trace for factors. t is the trace of the matrix and + ev is the percent of trace extracted } +label 40; +var + y, z : DblDyneVec; + ek, e2, d : real; + i, j, k, m : integer; +begin + SetLength(y,nv); + SetLength(z,nv); + t := 0.0; + for i := 0 to nv-1 do t := t + a[i,i]; + for k := 0 to nf-1 do + begin + for i := 0 to nv-1 do + begin + px[i] := 1.0; + y[i] := 1.0; + end; + e[k] := 1.0; + ek := 1.0; + for m := 1 to 25 do + begin + for i := 0 to nv-1 do + begin + v[i,k] := px[i] / e[k]; + z[i] := y[i] / ek; + end; + for i := 0 to nv-1 do + begin + px[i] := 0.0; + for j := 0 to nv-1 do px[i] := px[i] + a[i,j] * v[j,k]; + y[i] := 0.0; + for j := 0 to nv-1 do y[i] := y[i] + a[j,i] * z[j]; + end; + e2 := 0.0; + for j := 0 to nv-1 do e2 := e2 + px[j] * v[j,k]; + e[k] := sqrt(abs(e2)); + ek := 0.0; + for j := 0 to nv-1 do ek := ek + y[j] * z[j]; + ek := sqrt(abs(ek)); + end; + if e2 >= sqr(c) then + begin + d := 0.0; + for j := 0 to nv-1 do d := d + v[j,k] * z[j]; + d := e[k] / d; + for i := 0 to nv-1 do + for j := 0 to nv-1 do + a[i,j] := a[i,j] - v[i,k] * z[j] * d; + end + else begin + nf := k - 1; + goto 40; + end; + end; + 40 : for i := 0 to nf-1 do px[i] := e[i] / t * 100.0; + ev := 0.0; + for i := 0 to nf-1 do ev := ev + px[i]; + z := nil; + y := nil; +end; { of procedure nonsymroots } +//------------------------------------------------------------------- + +PROCEDURE ludcmp(VAR a: DblDyneMat; n: integer; VAR indx: IntDyneVec; VAR d: double); +CONST tiny=1.0e-20; +VAR k,j,imax,i: integer; + sum,dum,big: double; + vv: DblDyneVec; +BEGIN + SetLength(vv,n); + d := 1.0; imax := 0; + FOR i := 1 to n DO BEGIN + big := 0.0; + FOR j := 1 to n DO IF (abs(a[i-1,j-1]) > big) THEN big := abs(a[i-1,j-1]); + IF (big = 0.0) THEN BEGIN + ShowMessage('Singular matrix in Lower-Upper Decomposition routine'); + exit; + END; + vv[i-1] := 1.0/big + END; + FOR j := 1 to n DO BEGIN + IF (j > 1) THEN BEGIN + FOR i := 1 to j-1 DO BEGIN + sum := a[i-1,j-1]; + IF (i > 1) THEN BEGIN + FOR k := 1 to i-1 DO BEGIN + sum := sum - a[i-1,k-1] * a[k-1,j-1] + END; + a[i-1,j-1] := sum + END + END + END; + big := 0.0; + FOR i := j to n DO BEGIN + sum := a[i-1,j-1]; + IF (j > 1) THEN BEGIN + FOR k := 1 to j-1 DO BEGIN + sum := sum - a[i-1,k-1] * a[k-1,j-1] + END; + a[i-1,j-1] := sum + END; + dum := vv[i-1] * abs(sum); + IF (dum > big) THEN BEGIN + big := dum; + imax := i + END + END; + IF (j <> imax) THEN BEGIN + FOR k := 1 to n DO BEGIN + dum := a[imax-1,k-1]; + a[imax-1,k-1] := a[j-1,k-1]; + a[j-1,k-1] := dum + END; + d := -d; + vv[imax-1] := vv[j-1] + END; + indx[j-1] := imax; + IF (j <> n) THEN BEGIN + IF (a[j-1,j-1] = 0.0) THEN a[j-1,j-1] := tiny; + dum := 1.0/a[j-1,j-1]; + FOR i := j+1 to n DO BEGIN + a[i-1,j-1] := a[i-1,j-1] * dum + END + END + END; + IF (a[n-1,n-1] = 0.0) THEN a[n-1,n-1] := tiny; + vv := nil; +END; +//------------------------------------------------------------------- + +procedure DETERM(VAR a : DblDyneMat; rows, cols : integer; VAR determ : double; + VAR errorcode : boolean); +var indx : IntDyneVec; + i : integer; +begin + SetLength(indx,rows); + errorcode := FALSE; + if (rows <> cols) then errorcode := TRUE else + begin + LUDCMP(a, rows, indx, determ); + for i := 1 to rows do + determ := determ * a[i-1,i-1]; + end; +end; { of determ } +//------------------------------------------------------------------- + +procedure EffectCode(GridCol, min, max: integer; FactLetter: string; + var StartCol, EndCol, NoVectors: integer); +var + levels, i, j, grp, col, cval: integer; + coef: IntDyneMat; + labelstr: string; +begin + Assert(OS3MainFrm <> nil); + Assert(DictionaryFrm <> nil); + + // Routine for creating coded vectors representing group membership + // for purposes of multiple regression effects of group membership + levels := max - min + 1; + SetLength(coef,levels,levels); + novectors := levels - 1; + startcol := NoVariables + 1; + endcol := startcol + novectors - 1; + + // setup grid for additional columns + for i := 1 to levels - 1 do + begin + labelstr := FactLetter + IntToStr(i); + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := labelstr; + OS3MainFrm.DataGrid.Cells[col,0] := labelstr; + end; + + // get coefficients for effect coding + for i := 1 to levels do // group code + begin + for j := 1 to levels - 1 do // vector code + begin + if i = j then coef[i-1,j-1] := 1; + if i = levels then coef[i-1,j-1] := -1; + if (i <> j) and (i <> levels) then coef[i-1,j-1] := 0; + end; + end; + + // code the cases using coefficients above + col := NoVariables - (levels - 1); + for i := 1 to levels - 1 do + begin + col := col + 1; + for j := 1 to NoCases do + begin + // subject group code + grp := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[GridCol,j]))) - min + 1; + // vector code + cval := coef[grp-1,i-1]; + OS3MainFrm.DataGrid.Cells[col,j] := IntToStr(cval); + end; + end; + + OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); + coef := nil; +end; +//------------------------------------------------------------------- + +procedure MReg(NoIndep : integer; + {VAR} IndepCols : IntDyneVec; + DepCol : integer; + {VAR} RowLabels : StrDyneVec; + {VAR} Means : DblDyneVec; + {VAR} Variances : DblDyneVec; + {VAR} StdDevs : DblDyneVec; + {VAR} BWeights : DblDyneVec; + {VAR} BetaWeights : DblDyneVec; + {VAR} BStdErrs : DblDyneVec; + {VAR} Bttests : DblDyneVec; + {VAR} tProbs : DblDyneVec; + VAR R2 : double; + VAR stderrest : double; + VAR NCases : integer; + VAR errorcode : boolean; + PrintAll : boolean); +begin + MReg(NoIndep, IndepCols, Depcol, RowLabels,means, Variances, StdDevs, + BWeights, BetaWeights, BStdErrs, BtTests, tProbs, R2, StdErrEst, NCases, + ErrorCode, PrintAll, OutputFrm.RichEdit.Lines); +end; + +procedure MReg(NoIndep : integer; + {var} IndepCols : IntDyneVec; + DepCol : integer; + {var} RowLabels : StrDyneVec; + {var} Means : DblDyneVec; + {var} Variances : DblDyneVec; + {var} StdDevs : DblDyneVec; + {var} BWeights : DblDyneVec; + {var} BetaWeights : DblDyneVec; + {var} BStdErrs : DblDyneVec; + {var} Bttests : DblDyneVec; + {var} tProbs : DblDyneVec; + var R2 : double; + var StdErrEst : double; + var NCases : integer; + var ErrorCode : boolean; + PrintAll : boolean; + AReport: TStrings); +var + i, j, N: integer; + X: DblDyneMat; + XT: DblDyneMat; + XTX: DblDyneMat; + XTY: DblDyneVec; + Y: DblDyneVec; + indx: IntDyneVec; + ColLabels: StrDyneVec; + F, Prob, VarY, SDY, MeanY: double; + value, TOL, VIF, AdjR2: double; + SSY, SSres, resvar, SSreg: double; + title: string; + deplabel: string; + errcode: boolean; +begin + Assert(OS3MainFrm <> nil); + + SetLength(X, NoCases+1, NoIndep+1); // augmented independent var. matrix + SetLength(XT, NoIndep+1, NoCases); // transpose of independent var's + SetLength(XTX, NoIndep+1, NoIndep+1); // product of transpose X times X + SetLength(Y, NCases+1); // Y variable values + SetLength(XTY, NoIndep+1); // X transpose times Y + SetLength(indx, NoIndep+1); + SetLength(ColLabels, NCases); + + // initialize + for i := 0 to NCases do + begin + for j := 0 to NoIndep do X[i, j] := 0; + Y[i] := 0.0; + end; + for i := 0 to NoIndep do + begin + indx[i] := 0; + XTY[i] := 0.0; + Y[i] := 0.0; + tprobs[i] := 0.0; + Means[i] := 0.0; + Variances[i] := 0.0; + StdDevs[i] := 0.0; + BWeights[i] := 0.0; + BetaWeights[i] := 0.0; + errcode := false; + for j := 0 to NoCases-1 do XT[i, j] := 0.0; + for j := 0 to NoIndep do XTX[i, j] := 0.0; + end; + for i := 0 to NCases-1 do + ColLabels[i] := 'Case ' + IntToStr(i+1); + + SSY := 0.0; + VarY := 0.0; + SDY := 0.0; + MeanY := 0.0; + + // get independent matrix and Y vector from the grid + NCases := 0; + N := NoIndep + 1; + + for i := 1 to NoCases do + begin + if not GoodRecord(i, Noindep, IndepCols) then continue; + for j := 0 to NoIndep-1 do + begin + value := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[IndepCols[j], i])); + X[NCases, j] := value; + Means[j] := Means[j] + value; + Variances[j] := Variances[j] + value * value; + end; + value := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepCol, i])); + Y[NCases] := value; + MeanY := MeanY + value; + SSY := SSY + value * value; + Means[Noindep] := Means[Noindep] + value; + Variances[Noindep] := Variances[Noindep] + value * value; + NCases := NCases + 1; + end; + + deplabel := OS3MainFrm.DataGrid.Cells[DepCol,0]; + RowLabels[NoIndep] := 'Intercept'; + VarY := SSY - (MeanY * MeanY / NCases); + VarY := VarY / (NCases - 1); + SDY := sqrt(VarY); + + AReport.Add('Variance Y = %10.3f SSY = %10.3f SDY = %10.3f',[VarY,SSY,SDY]); + // OutputFrm.ShowModal ; + + // augment the matrix + for i := 1 to NCases do + X[i-1, NoIndep] := 1.0; + Y[NCases] := 1.0; + + // get transpose of augmented X matrix + MatTrn(XT, X, NCases, NoIndep+1); + if PrintAll then + begin + title := 'XT MATRIX'; + MatPrint(XT, NoIndep+1, NCases, title, RowLabels, ColLabels, NCases, AReport); + end; + + // get product of the augmented X transpose times augmented X + MatAXB(XTX, XT, X, NoIndep+1, NCases, NCases, NoIndep+1, errorcode); + if PrintAll then + begin + title := 'XTX MATRIX'; + MatPrint(XTX, Noindep+1, NoIndep+1, title, RowLabels, RowLabels, NCases, AReport); + end; + + //Get means, variances and standard deviations + errorcode := false; + for i := 0 to NoIndep do + begin + Variances[i] := XTX[i,i] - sqr(XTX[i, NoIndep])/NCases; + Variances[i] := Variances[i] / (NCases - 1); + if (Variances[i] > 0.0) then + StdDevs[i] := sqrt(Variances[i]) + else + errorcode := true; + Means[i] := XTX[N-1,i] / NCases; + end; + + if PrintAll then + begin + DynVectorPrint(Means, NoIndep+1, 'MEANS', RowLabels, NCases, AReport); + DynVectorPrint(Variances, NoIndep+1,'VARIANCES',RowLabels, NCases, AReport); + DynVectorPrint(StdDevs, NoIndep+1, 'STD. DEV.S', RowLabels, NCases, AReport); + + //OutputFrm.ShowModal; + //OutPutFrm.RichEdit.Clear; + end; + + // get product of the augmented X transpose matrix times the Y vector + for i := 0 to N-1 do + for j := 0 to NCases-1 do + XTY[i] := XTY[i] + (XT[i,j] * Y[j]); + if PrintAll then + DynVectorPrint(XTY, NoIndep+1, 'XTY VECTOR', RowLabels, NCases, AReport); + + // get inverse of the augmented cross products matrix among independent variables + SVDInverse(XTX,N); + if PrintAll then + begin + title := 'XTX MATRIX INVERSE'; + MatPrint(XTX, NoIndep+1, NoIndep+1, title, RowLabels, RowLabels, NCases, AReport); + end; + + // multiply augmented inverse matrix times the XTY vector + // result is bweights with the intercept last + for i := 0 to N-1 do + for j := 0 to N-1 do + BWeights[i] := BWeights[i] + (XTX[i,j] * XTY[j]); + + //Get Beta weightw + for i := 0 to N-2 do + BetaWeights[i] := BWeights[i] * StdDevs[i] / SDY; + + // Get standard errors, squared multiple correlation, tests of significance + SSres := 0.0; + for i := 0 to NoIndep do + SSres := SSres + (BWeights[i] * XTY[i]); + SSres := SSY - SSres; + resvar := SSres / (NCases - N); + if resvar > 0.0 then StdErrEst := sqrt(resvar) else StdErrest := 0.0; + for i := 0 to N-1 do // Standard errors and t-tedt values for weights + begin + BStdErrs[i] := sqrt(resvar * XTX[i,i]); + Bttests[i] := BWeights[i] / BStdErrs[i]; + tprobs[i] := probt(Bttests[i],NCases-N); + end; + SSY := VarY * (NCases-1); + SSreg := SSY - SSres; + R2 := SSreg / SSY; + F := (SSreg / (N - 1)) / (SSres / (NCases - N)); + Prob := probf(F,(N-1),(NCases-N)); + AdjR2 := 1.0 - (1.0 - R2) * (NCases - 1) / (NCases - N); + if PrintAll then + begin + AReport.Add('Dependent variable: ' + deplabel); + AReport.Add(''); + DynVectorPrint(BWeights, NoIndep+1, 'B WEIGHTS', RowLabels, NCases, AReport); + AReport.Add(''); + AReport.Add(''); + AReport.Add('Dependent variable: ' + deplabel); + AReport.Add(''); + DynVectorPrint(BetaWeights, NoIndep, 'BETA WEIGHTS', RowLabels, NCases, AReport); + AReport.Add(''); + AReport.Add(''); + DynVectorPrint(BStdErrs, NoIndep+1, 'B STD.ERRORS', RowLabels, NCases, AReport); + AReport.Add(''); + DynVectorPrint(Bttests, NoIndep+1, 'B t-test VALUES', RowLabels, NCases, AReport); + AReport.Add(''); + DynVectorPrint(tprobs, NoIndep+1, 'B t VALUE PROBABILITIES', RowLabels, NCases, AReport); + AReport.Add(''); + + AReport.Add('SSY: %10.2f', [SSY]); + AReport.Add('SSreg: %10.2f', [SSreg]); + AReport.Add('SSres: %10.2f', [SSres]); + AReport.Add('R2: %10.4f', [R2]); + AReport.Add('F: %10.2f (D.F. %d, %d)', [F, N-1, NCases-N]); +// AReport.Add('D.F. %d %d', [N-1, NCases-N]); + AReport.Add('Probability > F: %10.4f', [Prob]); + AReport.Add('Standard Error of Estimate: %10.2f', [stderrest]); + AReport.Add(''); + + //AReport.Add('SSY = %10.2f, SSreg = %10.2f, SSres = %10.2f', [SSY, SSreg, SSres]); + //AReport.Add('R2 = %6.4f, F = %8.2f, D.F. = %d %d, Prob>F = %6.4f', [R2, F, N-1, NCases-N, Prob]); + //AReport.Add('Standard Error of Estimate = %8.2f', [stderrest]); + end; + + RowLabels[N-1] := 'Intercept'; + AReport.Add(' Variable Beta B Std.Err. t prob VIF TOL'); + Correlations(NoIndep, IndepCols, XTX, Means, Variances, StdDevs, errcode, NCases); + SVDinverse(XTX, NoIndep); + for i := 0 to NoIndep do + begin + VIF := XTX[i,i]; + if VIF > 0.0 then TOL := 1.0 / VIF else TOL := 0.0; + AReport.Add('%10s%10.3f%10.3f%10.3f%10.3f%10.3f%10.3f%10.3f', [ + RowLabels[i], BetaWeights[i], BWeights[i], BStdErrs[i], Bttests[i], tprobs[i], VIF, TOL + ]); + end; + AReport.Add(''); + AReport.Add('SOURCE DF SS MS F Prob.>F'); + AReport.Add('Regression %3d %9.3f %9.3f %6.4f', [N-1, SSreg, SSreg/(N-1), F, Prob]); // df1 + AReport.Add('Residual %3d %9.3f %9.3f', [(NCases-N), SSres, SSres/(NCases-N)]); // df2 + AReport.Add('Total %3d %9.3f', [NCases-1, SSY]); + AReport.Add(''); + + AReport.Add('R2: %10.4f', [R2]); + AReport.Add('F: %10.2f (D.F. %d, %d)', [F, N-1, NCases-N]); +// AReport.Add('D.F. %d and %d', [N-1, NCases-N]); + AReport.Add('Probability > F: %10.4f', [Prob]); + AReport.Add('Adjusted R2: %10.4f', [AdjR2]); + AReport.Add('Standard Error of Estimate: %10.2f', [stderrest]); + + //AReport.Add('R2 = %6.4f, F = %8.2f, D.F. = %d %d Prob.>F = %6.4f', [R2, F, N-1, NCases-N, Prob]); + //AReport.Add('Adjusted R2 = %6.4f', [AdjR2]); + //AReport.Add('Standard Error of Estimate = %8.2f', [stderrest]); + + // clean up the heap + ColLabels := nil; + indx := nil; + XTY := nil; + Y := nil; + XTX := nil; + XT := nil; + X := nil; +end; +//------------------------------------------------------------------- + +procedure Dynnonsymroots(var a : DblDyneMat; nv : integer; + var nf : integer; c : real; + var v : DblDyneMat; var e : DblDyneVec; + var px : DblDyneVec; + var t : double; + var ev : double); +{ roots and vectors of a non symetric matrix. a is square matrix entered + and is destroyed in process. nv is number of variables (rows and columns ) + of a. nf is the number of factorsto be extracted - is output as the number + which exceeded c, the minimum eigenvalue to be extracted. v is the output + matrix of column vectors of loadings. e is the output vector of roots. px + is the percentages of trace for factors. t is the trace of the matrix and + ev is the percent of trace extracted } +label 40; +var + y, z : DblDyneVec; + ek, e2, d : real; + i, j, k, m : integer; +begin + SetLength(y,nv); + SetLength(z,nv); + t := 0.0; + for i := 0 to nv-1 do t := t + a[i,i]; + for k := 0 to nf-1 do + begin + for i := 0 to nv-1 do + begin + px[i] := 1.0; + y[i] := 1.0; + end; + e[k] := 1.0; + ek := 1.0; + for m := 1 to 25 do + begin + for i := 0 to nv-1 do + begin + v[i,k] := px[i] / e[k]; + z[i] := y[i] / ek; + end; + for i := 0 to nv - 1 do + begin + px[i] := 0.0; + for j := 0 to nv-1 do px[i] := px[i] + a[i,j] * v[j,k]; + y[i] := 0.0; + for j := 0 to nv-1 do y[i] := y[i] + a[j,i] * z[j]; + end; + e2 := 0.0; + for j := 0 to nv-1 do e2 := e2 + px[j] * v[j,k]; + e[k] := sqrt(abs(e2)); + ek := 0.0; + for j := 0 to nv-1 do ek := ek + y[j] * z[j]; + ek := sqrt(abs(ek)); + end; + if e2 >= sqr(c) then + begin + d := 0.0; + for j := 0 to nv - 1 do d := d + v[j,k] * z[j]; + d := e[k] / d; + for i := 0 to nv - 1 do + for j := 0 to nv - 1 do + a[i,j] := a[i,j] - v[i,k] * z[j] * d; + end + else begin + nf := k - 1; + goto 40; + end; + end; + 40 : for i := 0 to nf-1 do px[i] := e[i] / t * 100.0; + ev := 0.0; + for i := 0 to nf-1 do ev := ev + px[i]; + z := nil; + y := nil; +end; { of procedure nonsymroots } +//----------------------------------------------------------------------------- + +function DynCorrelations(novars : integer; + VAR ColSelected : IntDyneVec; + VAR DataGrid : DblDyneMat; + VAR rmatrix : DblDyneMat; + VAR means : DblDyneVec; + VAR vars : DblDyneVec; + VAR stddevs : DblDyneVec; + NCases : integer; + ReturnType : integer) : integer; +var + i, j, k, row, col, errorcode : integer; + X, Y : double; +begin + errorcode := 0; + for i := 0 to novars - 1 do + begin + means[i] := 0.0; + vars[i] := 0.0; + stdDevs[i] := 0.0; + for j := 0 to novars - 1 do + begin + rmatrix[i,j] := 0.0; + end; + end; + { get cross products } + for i := 0 to NCases - 1 do + begin + if IsFiltered(i) then continue; + for j := 0 to novars - 1 do + begin + row := ColSelected[j]; + X := DataGrid[i,row]; + means[j] := means[j] + X; + vars[j] := vars[j] + (X * X); + for k := 0 to novars - 1 do + begin + col := ColSelected[k]; + Y := DataGrid[i,col]; + rmatrix[j,k] := rmatrix[j,k] + (X * Y); + end; + end; + end; + for j := 0 to novars - 1 do + begin + vars[j] := vars[j] - (means[j] * means[j] / NCases); + vars[j] := vars[j] / (NCases-1); + if (vars[j] > 0.0) then stddevs[j] := sqrt(vars[j]) + else stddevs[j] := 0.0; + end; + if ReturnType = 1 then {return cross-products, variances, std.devs, means } + begin + for i := 0 to novars - 1 do + begin + means[i] := means[i] / NCases; + end; + DynCorrelations := errorcode; + exit; + end; + + for i := 0 to novars - 1 do {get variance-covariance matrix } + begin + for j := 0 to novars - 1 do + begin + rmatrix[i,j] := rmatrix[i,j] - (means[i] * means[j] / NCases); + rmatrix[i,j] := rmatrix[i,j] / (NCases - 1); + end; + end; + if ReturnType = 2 then + begin + for i := 0 to novars - 1 do + begin + means[i] := means[i] / NCases; + end; + DynCorrelations := errorcode; + exit; + end; + + for i := 0 to novars - 1 do { get product-moment correlations } + begin + for j := 0 to novars - 1 do + begin + if ((stddevs[i] > 0.0) and (stddevs[j] > 0.0)) then + rmatrix[i,j] := rmatrix[i,j] / (stddevs[i] * stddevs[j]) + else + begin + rmatrix[i,j] := 9.999; + errorcode := 1; + end; + end; + end; + for i := 0 to novars - 1 do + begin + means[i] := means[i] / NCases; + end; + DynCorrelations := errorcode; +end; +//--------------------------------------------------------------------------- + +procedure Predict(VAR ColNoSelected : IntDyneVec; + NoVars : integer; + VAR IndepInverse : DblDyneMat; + VAR Means : DblDyneVec; + VAR StdDevs : DblDyneVec; + VAR BetaWeights : DblDyneVec; + StdErrEst : double; + VAR IndepIndex : IntDyneVec; + NoIndepVars : integer); +var + col, i, j, k, index, IndexX, IndexY : integer; + predicted, zpredicted, z1, z2, resid, Term1, Term2 : double; + StdErrPredict, t95, Hi95, Low95 : double; + +begin + Assert(OS3MainFrm <> nil); + Assert(DictionaryFrm <> nil); + + { use the next available grid column to store the z predicted score } + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'Pred.z'; + OS3MainFrm.DataGrid.Cells[col,0] := 'Pred.z'; + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'z Resid.'; + OS3MainFrm.DataGrid.Cells[col,0] := 'z Resid.'; + for i := 1 to NoCases do + begin + zpredicted := 0.0; + for j := 1 to NoIndepVars do + begin + Index := IndepIndex[j-1]; + k := ColNoSelected[Index-1]; + z1 := (StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[k,i])) - + Means[Index-1]) / StdDevs[index-1]; + zpredicted := zpredicted + (z1 * BetaWeights[j-1]); + OS3MainFrm.DataGrid.Cells[col-1,i] := format('%8.4f',[zpredicted]); + end; + Index := ColNoSelected[NoVars-1]; + z2 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[Index,i])); + z2 := (z2 - Means[NoVars-1]) / StdDevs[NoVars-1]; + OS3MainFrm.DataGrid.Cells[col,i] := format('%8.4f',[(z2 - zpredicted)]); + end; + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'Pred.Raw'; + OS3MainFrm.DataGrid.Cells[col,0] := 'Pred.Raw'; + { calculate raw predicted scores and store in grid at col } + for i := 1 to NoCases do + begin + predicted := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col-2,i])) * + StdDevs[NoVars-1] + Means[NoVars-1]; + OS3MainFrm.DataGrid.Cells[col,i] := format('%8.3f',[predicted]); + end; + { Calculate residuals of predicted raw scores } + col := NoVariables +1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'Raw Resid.'; + OS3MainFrm.DataGrid.Cells[col,0] := 'Raw Resid.'; + for i := 1 to NoCases do + begin + Index := ColNoSelected[NoVars-1]; + resid := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col-1,i])) - + StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[Index,i])); + OS3MainFrm.DataGrid.Cells[col,i] := Format('%8.3f',[resid]); + end; + { Calculate Confidence Interval for raw predicted score } + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'StdErrPred'; + OS3MainFrm.DataGrid.Cells[col,0] := 'StdErrPred'; + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'Low 95%'; + OS3MainFrm.DataGrid.Cells[col,0] := 'Low 95%'; + col := NoVariables + 1; + DictionaryFrm.NewVar(col); + DictionaryFrm.DictGrid.Cells[1,col] := 'Top 95%'; + OS3MainFrm.DataGrid.Cells[col,0] := 'Top 95%'; + for i := 1 to NoCases do + begin + { get term1 of the std. err. prediction } + Term1 := 0.0; + for j := 1 to NoIndepVars do + begin + Index := IndepIndex[j-1]; + col := ColNoSelected[Index-1]; + z1 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); + z1 := (z1 - Means[Index-1]) / StdDevs[Index-1]; + z1 := (z1 * z1) * IndepInverse[j-1,j-1]; + Term1 := Term1 + z1; + end; + { get term2 of the std err. of prediction } + term2 := 0.0; + for j := 1 to NoIndepVars - 1 do + begin + for k := j + 1 to NoIndepVars do + begin + IndexX := IndepIndex[j-1]; + col := ColNoSelected[IndexX-1]; + z1 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); + IndexY := IndepIndex[k-1]; + col := ColNoSelected[IndexY-1]; + z2 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); + z1 := (z1 - Means[IndexX-1]) / StdDevs[IndexX-1]; + z2 := (z2 - Means[IndexY-1]) / StdDevs[IndexY-1]; + Term2 := Term2 + IndepInverse[j-1,k-1] * z1 * z2; + end; + end; + term2 := 2.0 * Term2; + StdErrPredict := sqrt(NoCases + 1 + Term1 + Term2); + StdErrPredict := (StdErrEst / sqrt(NoCases)) * StdErrPredict; + t95 := Inverset(0.975,NoCases-NoIndepVars-1); + low95 := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[NoVars+4,i])); + hi95 := low95; + low95 := low95 - (t95 * StdErrPredict); + hi95 := hi95 + (t95 * StdErrPredict); + OS3MainFrm.DataGrid.Cells[NoVariables,i] := Format('%8.3f',[hi95]); + OS3MainFrm.DataGrid.Cells[NoVariables-1,i] := Format('%8.3f',[low95]); + OS3MainFrm.DataGrid.Cells[NoVariables-2,i] := Format('%8.3f',[StdErrPredict]); + end; { next case } +end; +//--------------------------------------------------------------------------- + +procedure MReg2(NCases : integer; + NoVars : integer; + VAR NoIndepVars : integer; + VAR IndepIndex : IntDyneVec; + VAR corrs : DblDyneMat; + VAR IndepCorrs : DblDyneMat; + VAR RowLabels : StrDyneVec; + VAR R2 : double; + VAR BetaWeights : DblDyneVec; + VAR Means : DblDyneVec; + VAR Variances : DblDyneVec; + VAR errorcode : integer; + VAR StdErrEst : double; + VAR constant : double; + probout : double; + Printit : boolean; + TestOut : boolean; + PrintInv : boolean; + AReport: TStrings); +{ + The following routine obtains multiple regression results for a + correlation matrix consisting of 1 to NoVars. The last variable + represents the dependent variable. The number of independent + variables is passed as NoIndepVars. The inverse matrix of independent + variables may be obtained by the calling program using the variable + IndepCorrs. The user may request printing of the inverse using the + boolean variable Printit. +} +var + i, j, k, l : integer; + IndexX, IndexY : integer; + IndRowLabels : StrDyneVec; + IndColLabels : StrDyneVec; + XYCorrs : DblDyneVec; + df1, df2, df3 : double; + SSt, SSres, SSreg : double; + VarEst, F : double; + FprobF : double; + outline : string; + valstring : string; + title : string; + deplabel : string; + sum, B, Beta : double; + SSx, StdErrB : double; + AdjR2 : double; + VIF, TOL : double; + outcount : integer; + varsout : IntDyneVec; +begin + Assert(OutputFrm <> nil); + Assert(AReport <> nil); + + SetLength(IndRowLabels,NoVars); + SetLength(IndColLabels,NoVars); + SetLength(XYCorrs,NoVars); + SetLength(varsout,NoVars); + + errorcode := 0; + outcount := 0; + VIF := 0.0; + deplabel := RowLabels[NoVars-1]; + for i := 0 to NoIndepVars-1 do + begin + IndexX := IndepIndex[i]; + for j := 0 to NoIndepVars-1 do + begin + IndexY := IndepIndex[j]; + IndepCorrs[i,j] := corrs[IndexX-1,IndexY-1]; + end; + end; + for i := 0 to NoIndepVars-1 do + begin + IndRowLabels[i] := RowLabels[IndepIndex[i]-1]; + IndColLabels[i] := RowLabels[IndepIndex[i]-1]; + XYCorrs[i] := corrs[IndepIndex[i]-1,NoVars-1]; + end; + SVDinverse(IndepCorrs,NoIndepVars); + + if PrintInv then + begin + title := 'Inverse of independent variables matrix'; + MatPrint(IndepCorrs, NoIndepVars, NoIndepVars, title, IndRowLabels, IndColLabels, NCases, AReport); + end; + + { Get product of inverse matrix times vector of correlations + between independent and dependent variables } + R2 := 0.0; + for i := 0 to NoIndepVars-1 do + begin + BetaWeights[i] := 0.0; + for j := 0 to NoIndepVars-1 do + BetaWeights[i] := BetaWeights[i] + IndepCorrs[i,j] * XYCorrs[j]; + R2 := R2 + BetaWeights[i] * XYCorrs[i]; + end; + + df1 := NoIndepVars; + df2 := NCases - NoIndepVars - 1; + df3 := NCases - 1; + SSt := (NCases-1) * Variances[NoVars-1]; + SSres := SSt * (1.0 - R2); + SSreg := SSt - SSres; + VarEst := SSres / df2; + if (VarEst > 0.0) then + StdErrEst := sqrt(VarEst) + else + begin + MessageDlg('Error in computing variance estimate.', mtError, [mbOK], 0); + StdErrEst := 0.0; + end; + if (R2 < 1.0) and (df2 > 0.0) and (df1 > 0.0) then + F := (R2 / df1) / ((1.0-R2)/ df2) + else + F := 0.0; + FProbF := probf(F,df1,df2); + + AReport.Add('SOURCE DF SS MS F Prob.>F'); + AReport.Add('Regression %3.0f %9.3f %9.3f %9.3f %9.3f', [df1, SSreg, SSreg/df1, F, FprobF]); + AReport.Add('Residual %3.0f %9.3f %9.3f', [df2, SSres, SSres/df2]); + AReport.Add('Total %3.0f %9.3f', [df3, SSt]); + AReport.Add(''); + + AdjR2 := 1.0 - (1.0 - R2) * (NCases - 1) / df2; + if PrintIt then + begin + AReport.Add('Dependent Variable: ' + deplabel); + AReport.Add(''); + AReport.Add('%8s%10s%10s%12s%5s%5s', ['R', 'R2', 'F', 'Prob.>F', 'DF1', 'DF2']); + AReport.Add('%8.3f%10.3f%10.3f%10.3f%5.0f%5.0f', [sqrt(R2), R2, F, FProbF, df1, df2]); + AReport.Add('Adjusted R Squared: %10.3f', [AdjR2]); + AReport.Add(''); + AReport.Add('Std. Error of Estimate: %10.3f', [StdErrEst]); + AReport.Add(''); + AReport.Add('Variable Beta B Std.Error t Prob.>t VIF TOL'); + end; + + df1 := 1.0; + df2 := NCases - NoIndepVars - 1; + sum := 0.0; + for i := 0 to NoIndepVars-1 do + begin + beta := BetaWeights[i]; + B := beta * sqrt(Variances[NoVars-1]) / sqrt(Variances[IndepIndex[i]-1]); + sum := sum + B * Means[IndepIndex[i]-1]; + SSx := (NCases-1) * Variances[IndepIndex[i]-1]; + if (IndepCorrs[i,i] > 0.0) and (VarEst > 0.0) then + begin + StdErrB := sqrt(VarEst / (SSx * (1.0 / IndepCorrs[i,i]))); + F := B / StdErrB; + FProbF := probf(F*F,df1,df2); + VIF := IndepCorrs[i,i]; + TOL := 1.0 / VIF; + end + else + begin + MessageDlg('Error in estimating std.err. of a B', mtError, [mbOK], 0); + StdErrB := 0.0; + F := 0.0; + FProbF := 0.0; + end; + + if PrintIt then + begin + valstring := Format('%10s', [IndRowLabels[i]]); + outline := Format('%10s%10.3f%10.3f%10.3f%10.3f%10.3f%10.3f%10.3f', + [valstring, beta ,B, StdErrB, F, FProbF, VIF, TOL]); + if FprobF > ProbOut then + outline := outline + ' Exceeds limit - to be removed.'; + AReport.Add(outline); + end; + + if FprobF > ProbOut then + begin + outcount := outcount + 1; + varsout[outcount-1] := IndepIndex[i]; + end; + end; + + if PrintIt then + AReport.Add(''); + + { Get constant } + constant := Means[NoVars-1] - sum; + if PrintIt then + AReport.Add('Constant: %10.3f', [constant]); + + { Now remove any variables that exceed tolerance } + if (outcount > 0) and (TestOut = true) then + begin + for i := 0 to outcount-1 do + begin + k := varsout[i]; { variable to eliminate } + for j := 0 to NoIndepVars-1 do + begin + if IndepIndex[j] = k then {eliminate this one } + begin + for l := j to NoIndepVars-2 do + IndepIndex[l] := IndepIndex[l+1]; + end; + end; + end; + NoIndepVars := NoIndepVars - outcount; + errorcode := outcount; + end; + + varsout := nil; + XYCorrs := nil; + IndColLabels := nil; + IndRowLabels := nil; +end; +//--------------------------------------------------------------------------- + +procedure MATSUB(VAR a, b, c : DblDyneMat; + brows, bcols, crows, ccols : integer; VAR errorcode : boolean); +// Subtracts matrix c from b and returns the results in matrix a +var i, j : integer; +begin + errorcode := FALSE; + if ((brows <> crows) or (bcols <> ccols)) then errorcode := TRUE + else + begin + for i := 0 to brows-1 do + for j := 0 to bcols-1 do + a[i,j] := b[i,j] - c[i,j]; + end; +end; { of matsub } +//--------------------------------------------------------------------------- + +procedure IntArrayPrint(mat : IntDyneMat; + rows, cols : integer; + ytitle : string; + RowLabels, ColLabels : StrDyneVec; + Title : string); +begin + Assert(OutputFrm <> nil); + IntArrayPrint(mat, rows, cols, ytitle, RowLabels, ColLabels, Title, OutputFrm.RichEdit.Lines); +end; + +procedure IntArrayPrint(Mat: IntDyneMat; + Rows, Cols: integer; + YTitle: string; + RowLabels, ColLabels: StrDyneVec; + Title: string; + AReport: TStrings); +var + i, j, first, last, nflds: integer; + done : boolean; + outline: string; + valstring: string; +begin + AReport.Add(''); + AReport.Add(Title); + AReport.Add(''); + nflds := 4; + done := FALSE; + first := 1; + + while not done do + begin + AReport.Add(''); + AReport.Add(' ' + ytitle);; + AReport.Add('Variables'); + + outline := ' '; + last := first + nflds; + if last >= cols then + begin + done := TRUE; + last := cols + end; + for i := first to last do + outline := outline + Format('%13s', [ColLabels[i-1]]); + AReport.Add(outline); + + for i := 1 to rows do + begin + outline := format('%10s', [RowLabels[i-1]]); + for j := first to last do + outline := outline + Format('%12d ',[mat[i-1,j-1]]); + AReport.Add(outline); + end; + AReport.Add(''); + first := last + 1 + end; + AReport.Add(''); + AReport.Add(''); +end; +//--------------------------------------------------------------------------- + +procedure eigens(VAR a: DblDyneMat; Var d : DblDyneVec; n : integer); + +var e : DblDyneVec; + i : integer; + +begin + SetLength(e,n); + for i := 1 to n do + begin + d[i-1] := 0.0; + e[i-1] := 0.0; + end; + + tred2(a, n, d ,e ); { Upon return, d contains diagonal values, e contains + off diagonal values, and a contains the orthogonal + matrix from the tridiagonalization of the a matrix } + + tqli(d, e, n, a); { Upon return, d contains eigenvalues, a the column + eigenvectors of the tridiagonal matrix (in d and e). } + e := nil; +end; { Procedure eigens } +//------------------------------------------------------------------- + +PROCEDURE tred2(VAR a: DblDyneMat; n: integer; VAR d,e: DblDyneVec); +(* Programs using routine TRED2 must define the types +TYPE + glnp = ARRAY [1..np] OF real; + glnpnp = ARRAY [1..np,1..np] OF real; +where 'np by np' is the physical dimension of the matrix to be analyzed. *) + +VAR + l,k,j,i: integer; + scale,hh,h,g,f: double; +BEGIN + IF (n > 1) THEN BEGIN + FOR i := n DOWNTO 2 DO BEGIN + l := i-1; + h := 0.0; + scale := 0.0; + IF (l > 1) THEN BEGIN + FOR k := 1 to l DO BEGIN + scale := scale+abs(a[i-1,k-1]) + END; + IF (scale = 0.0) THEN BEGIN + e[i-1] := a[i-1,l-1] + END ELSE BEGIN + FOR k := 1 to l DO BEGIN + a[i-1,k-1] := a[i-1,k-1]/scale; + h := h+sqr(a[i-1,k-1]) + END; + f := a[i-1,l-1]; + g := -sign(sqrt(h),f); + e[i-1] := scale*g; + h := h-f*g; + a[i-1,l-1] := f-g; + f := 0.0; + FOR j := 1 to l DO BEGIN + (* Next statement can be omitted if eigenvectors not wanted *) + a[j-1,i-1] := a[i-1,j-1]/h; + g := 0.0; + FOR k := 1 to j DO BEGIN + g := g+a[j-1,k-1]*a[i-1,k-1] + END; + IF (l > j) THEN FOR k := j+1 to l DO g := g+a[k-1,j-1]*a[i-1,k-1]; + e[j-1] := g/h; + f := f+e[j-1]*a[i-1,j-1] + END; + hh := f/(h+h); + FOR j := 1 to l DO BEGIN + f := a[i-1,j-1]; + g := e[j-1]-hh*f; + e[j-1] := g; + FOR k := 1 to j DO a[j-1,k-1] := a[j-1,k-1]-f*e[k-1]-g*a[i-1,k-1] + END + END + END ELSE BEGIN + e[i-1] := a[i-1,l-1] + END; + d[i-1] := h + END + END; + (* Next statement can be omitted if eigenvectors not wanted *) + d[0] := 0.0; + e[0] := 0.0; + FOR i := 1 to n DO BEGIN + (* Contents of this loop can be omitted if eigenvectors not wanted, + except for statement d[i] := a[i,i]; *) + l := i-1; + IF (d[i-1] <> 0.0) THEN BEGIN + FOR j := 1 to l DO BEGIN + g := 0.0; + FOR k := 1 to l DO BEGIN + g := g+a[i-1,k-1]*a[k-1,j-1] + END; + FOR k := 1 to l DO BEGIN + a[k-1,j-1] := a[k-1,j-1]-g*a[k-1,i-1] + END + END + END; + d[i-1] := a[i-1,i-1]; + a[i-1,i-1] := 1.0; + IF (l >= 1) THEN BEGIN + FOR j := 1 to l DO BEGIN + a[i-1,j-1] := 0.0; + a[j-1,i-1] := 0.0 + END + END + END +END; +//------------------------------------------------------------------- + +PROCEDURE tqli(VAR d,e: DblDyneVec; n: integer; VAR z: DblDyneMat); +LABEL 1,2; +VAR + m,l,iter,i,k: integer; + s,r,p,g,f,dd,c,b: double; +BEGIN + IF (n > 1) THEN BEGIN + FOR i := 2 to n DO BEGIN + e[i-2] := e[i-1] + END; + e[n-1] := 0.0; + FOR l := 1 to n DO BEGIN + iter := 0; +1: FOR m := l to n-1 DO BEGIN + dd := abs(d[m-1])+abs(d[m]); + IF (abs(e[m-1])+ dd = dd) THEN GOTO 2 + END; + m := n; +2: IF (m <> l) THEN BEGIN + IF (iter = 30) THEN BEGIN + ShowMessage('Too many iterations in routine tqli'); + exit; + END; + iter := iter+1; + g := (d[l]-d[l-1])/(2.0*e[l-1]); + r := sqrt(sqr(g)+1.0); + g := d[m-1] - d[l-1] + e[l-1] / (g+sign(r,g)); + s := 1.0; + c := 1.0; + p := 0.0; + FOR i := m-1 DOWNTO l DO BEGIN + f := s * e[i-1]; + b := c * e[i-1]; + IF (abs(f) >= abs(g)) THEN BEGIN + c := g / f; + r := sqrt(sqr(c) + 1.0); + e[i] := f * r; + s := 1.0 / r; + c := c * s + END ELSE BEGIN + s := f / g; + r := sqrt(sqr(s) + 1.0); + e[i] := g * r; + c := 1.0 / r; + s := s * c + END; + g := d[i] - p; + r := (d[i-1] - g) * s + 2.0 * c * b; + p := s * r; + d[i] := g + p; + g := c * r - b; + (* Next loop can be omitted if eigenvectors not wanted *) + FOR k := 1 to n DO BEGIN + f := z[k-1,i]; + z[k-1,i] := s * z[k-1,i-1] + c * f; + z[k-1,i-1] := c * z[k-1,i-1] - s * f + END + END; + d[l-1] := d[l-1] - p; + e[l-1] := g; + e[m-1] := 0.0; + GOTO 1 + END + END + END +END; +//------------------------------------------------------------------- + +function SEVS(nv,nf : integer; + c : double; + var r : DblDyneMat; + VAR v : DblDyneMat; + VAR e : DblDyneVec; + var p : DblDyneVec; + VAR nd : integer) : integer ; + +{ extracts roots and denormal vectors from a symetric matrix. Veldman, 1967, + page 209 } + +label 1,2; + +var t, ee, ev : double; + i, j, k, m : integer; + +begin + t := 0.0; + for i := 1 to nv do t := t + r[i-1,i-1]; + for k := 1 to nf do { compute roots in e[k] and vector in v^[.k] } + begin + for i := 1 to nv do p[i-1] := 1.0; + begin + e[k-1] := 1.0; + for m := 1 to 25 do + begin + for i := 1 to nv do v[i-1,k-1] := p[i-1] / e[k-1]; + for i := 1 to nv do p[i-1] := SCPF(r,v,-i,k,nv,nd); + ee := 0.0; + for j := 1 to nv do ee := ee + p[j-1] * v[j-1,k-1]; + e[k-1] := sqrt(abs(ee)); + end; + end; + if ee < (c * c) then goto 1; + for i := 1 to nv do + for j := 1 to nv do + r[i-1,j-1] := r[i-1,j-1] - (v[i-1,k-1] * v[j-1,k-1]); + end; + goto 2; +1 : nf := k - 1; +2 : for i := 1 to nf do p[i-1] := e[i-1] / t * 100.0; + ev := 0.0; + for i := 1 to nf do ev := ev + p[i-1]; +{ + stopit; + writeln(lst); + writeln(lst,'Root % Extracted'); + for i := 1 to nf do writeln(lst,i:3,' ',p^[i]:6:3); + writeln(lst,' Trace = ',t:6:3,' % Extracted = ',ev:6:3); + writeln(lst); +} + result := nf; +end; { of SEVS procedure } +//------------------------------------------------------------------- + +function SCPF(VAR x,y : DblDyneMat; kx,ky,n,nd : integer) : double; + +{ sum of cross products of two vectors. Veldman, 1967, pp 128-129 } +var j,k,i : integer; + scp : double; + +begin + scp := 0.0; + scpf := 0.0; + j := abs(kx); + k := abs(ky); + if ((kx = 0) and (ky = 0)) then exit; + if ((kx < 0) and (ky < 0)) then + begin + for i := 1 to n do scp := scp + x[j-1,i-1] * y[k-1,i-1]; + end; + if ((kx < 0) and (ky > 0)) then + begin + for i := 1 to n do scp := scp + x[j-1,i-1] * y[i-1,k-1]; + end; + if ((kx > 0) and (ky < 0)) then + begin + for i := 1 to n do scp := scp + x[i-1,j-1] * y[k-1,i-1]; + end; + if ((kx > 0) and (ky > 0)) then + begin + for i := 1 to n do scp := scp + x[i-1,j-1] * y[i-1,k-1]; + end; + scpf := scp; +end; { of SCPF } +//------------------------------------------------------------------- + +procedure Mat_Print(var xmat: DblDyneMat; Rows, Cols: Integer; var Title: String; + var RowLabels, ColLabels: StrDyneVec; NCases: integer); +begin + MatPrint(xmat, Rows, Cols, Title, RowLabels, ColLabels, NCases, OutputFrm.RichEdit.Lines); +end; + +procedure MatPrint(var xmat: DblDyneMat; Rows, Cols: integer; var Title: string; + var RowLabels, ColLabels: StrDyneVec; NCases: integer; AReport: TStrings); +var + i, j, first, last, nflds: integer; + done: boolean; + outline: string; + valstring: string; +begin + Assert(AReport <> nil); + + AReport.Add('%s with %d cases.', [Title, NCases]); + AReport.Add(''); + nflds := 4; + done := FALSE; + first := 1; + while not done do + begin + AReport.Add('Variables'); + outline := ' '; + last := first + nflds; + if last >= cols then + begin + done := true; + last := cols; + end; + for i := first to last do + outline := outline + Format('%12s ',[ColLabels[i-1]]); + AReport.Add(outline); + + for i := 1 to rows do + begin + outline := format('%10s',[RowLabels[i-1]]); + for j := first to last do + begin + valstring := format('%12.3f ',[xmat[i-1,j-1]]); + outline := outline + valstring; + end; + AReport.Add(outline); + end; + if not done then AReport.Add(''); + first := last + 1; + end; + AReport.Add(''); +// AReport.Add(''); +end; +//-------------------------------------------------------------------- + +procedure DynVectorPrint(var AVector: DblDyneVec; + NoVars: integer; + Title: string; + var Labels: StrDyneVec; + NCases: integer); +begin + DynVectorPrint(AVector, NoVars, Title, Labels, NCases, OutputFrm.RichEdit.Lines); +end; + +procedure DynVectorPrint(var AVector: DblDyneVec; + NoVars: integer; + Title: string; + var Labels: StrDyneVec; + NCases: integer; + AReport: TStrings); +var + i, j, first, last, nflds: integer; + done: boolean; + outline: string; + valstring: string; +begin + Assert(AReport <> nil); + +// AReport.Add(''); + AReport.Add('%s with %d valid cases.', [Title, NCases]); + + nflds := 4; + done := FALSE; + first := 0; + while not done do + begin + AReport.Add(''); + outline := 'Variables'; + last := first + nflds; + if last >= NoVars -1 then + begin + done := true; + last := NoVars-1; + end; + for i := first to last do + outline := outline + Format('%13s', [Labels[i]]); + AReport.Add(outline); + + outline := ' '; + for j := first to last do + begin + valstring := Format('%12.3f ', [AVector[j]]); + outline := outline + valstring; + end; + AReport.Add(outline); + first := last + 1 + end; + AReport.Add(''); +end; +//-------------------------------------------------------------------------- + +procedure scatplot(var x : DblDyneVec; + var y : DblDyneVec; + nocases : integer; + titlestr : string; + x_axis, y_axis : string; + x_min, x_max, y_min, y_max : double; + VAR VarLabels : StrDyneVec); + +var + i, j, l, row, xslot : integer; + xdelta, maxy: double; + incrementx, incrementy, rangex, rangey, swap : double; + plotstring : array[0..51,0..61] of char; + ymed, xmed : double; + height : integer; + overlap : boolean; + valuestring : string[2]; + howlong : integer; + outline : string; + Labels : StrDyneVec; +begin + Assert(OutputFrm <> nil); + + SetLength(Labels,NoVariables); + for i := 1 to nocases do Labels[i-1] := VarLabels[i-1]; + height := 40; + rangex := x_max - x_min ; + incrementx := rangex / 15.0; + xdelta := rangex / 60; + xmed := rangex / 2; + rangey := y_max - y_min; + incrementy := rangey / height; + ymed := rangey / 2; + + { sort in descending order } + for i := 1 to (nocases - 1) do + begin + for j := (i + 1) to nocases do + begin + if y[i-1] < y[j-1] then + begin + swap := y[i-1]; + y[i-1] := y[j-1]; + y[j-1] := swap; + swap := x[i-1]; + x[i-1] := x[j-1]; + x[j-1] := swap; + outline := Labels[i-1]; + Labels[i-1] := Labels[j-1]; + Labels[j-1] := outline; + end; + end; + end; + outline := ' SCATTERPLOT - ' + titlestr; + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add(y_axis); + maxy := y_max; + for i := 1 to 60 do + for j := 1 to height+1 do plotstring[j,i] := ' '; + + { Set up the plot strings with the data } + row := 0; + while maxy > y_min do + begin + row := row + 1; + plotstring[row,30] := '|'; + if (row = (height / 2)) then + begin + for i := 1 to 60 do plotstring[row,i] := '-'; + end; + for i := 1 to nocases do + begin + if ((maxy >= y[i-1]) and (y[i-1] > (maxy - incrementy))) then + begin + xslot := round(((x[i-1] - x_min) / rangex) * 60); + if xslot < 1 then xslot := 1; + if xslot > 60 then xslot := 60; + overlap := false; + str(i:2,valuestring); + howlong := 1; + if (valuestring[1] <> ' ') then howlong := 2; + for l := xslot to (xslot + howlong - 1) do + if (plotstring[row,l] = '*') then overlap := true; + if (overlap) then plotstring[row,xslot] := '*' + else + begin + if (howlong < 2) then + plotstring[row,xslot] := valuestring[2] + else for l := 1 to 2 do + plotstring[row,xslot + l - 1] := valuestring[l]; + end; + end; + end; + maxy := maxy - incrementy; + end; + { print the plot } + for i := 1 to row do + begin + outline := ' |'; + for j := 1 to 60 do outline := outline + format('%1s',[plotstring[i,j]]); + outline := outline + format('|-%6.2f-%6.2f', + [(y_max - i * incrementy),(y_max - i * incrementy + incrementy)]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + outline := ''; + for i := 1 to 63 do outline := outline + '-'; + OutputFrm.RichEdit.Lines.Add(outline); + outline := ''; + for i := 1 to 16 do outline := outline + ' | '; + outline := outline + x_axis; + OutputFrm.RichEdit.Lines.Add(outline); + outline := ''; + for i := 1 to 16 do outline := outline + format('%4.1f',[(x_min + i * incrementx - incrementx)]); + OutputFrm.RichEdit.Lines.Add(outline); + OutputFrm.RichEdit.Lines.Add(''); + OutputFrm.RichEdit.Lines.Add('Labels:'); + for i := 1 to nocases do + begin + outline := format('%2d = %s',[i,Labels[i-1]]); + OutputFrm.RichEdit.Lines.Add(outline); + end; + OutputFrm.ShowModal; + OutputFrm.RichEdit.Clear; + Labels := nil; +end; { of scatplot procedure } +//------------------------------------------------------------------- + +procedure DynIntMatPrint(Mat: IntDyneMat; Rows, Cols: integer; YTitle: string; + RowLabels, ColLabels: StrDyneVec; Title: string); +begin + DynIntMatPrint(Mat, Rows, Cols, YTitle, RowLabels, ColLabels, Title, OutputFrm.RichEdit.Lines); +end; + +procedure DynIntMatPrint(Mat: IntDyneMat; Rows, Cols: integer; YTitle: string; + RowLabels, ColLabels: StrDyneVec; Title: string; AReport: TStrings); +var + i, j, first, last, nflds: integer; + done: boolean; + outline: string; + valstring: string; +begin + Assert(AReport <> nil); + + AReport.Add(Title); + AReport.Add(''); + + nflds := 4; + done := false; + first := 0; + while not done do + begin + AReport.Add(''); + AReport.Add(' ' + ytitle); + AReport.Add('Variables'); + outline := ' '; + last := first + nflds; + if last >= Cols-1 then + begin + done := true; + last := Cols-1; + end; + for i := first to last do + outline := outline + Format('%13s', [ColLabels[i]]); + AReport.Add(outline); + + for i := 0 to rows-1 do + begin + outline := Format('%10s', [RowLabels[i]]); + for j := first to last do + begin + valstring := Format('%12d ', [Mat[i,j]]); + outline := outline + valstring; + end; + AReport.Add(outline); + end; + AReport.Add(''); + first := last + 1 + end; + AReport.Add(''); + AReport.Add(''); +end; + +procedure SymMatRoots(A: DblDyneMat; M: integer; var E: DblDyneVec; +var V: DblDyneMat); +Label one, three, nine, fifteen; +var + L, IT, j, k : integer; + Test, sum1, sum2 : double; + X, Y, Z : DblDyneVec; + +begin +// Adapted from: "Multivariate Data Analysis" by William W. Cooley and Paul +// R. Lohnes, 1971, page 121 + SetLength(X, M); + SetLength(Y, M); + SetLength(Z, M); + sum2 := 0.0; + L := 0; + Test := 0.00000001; +one: + IT := 0; + for j := 0 to M-1 do Y[j] := 1.0; +three: + IT := IT + 1; + for j := 0 to M-1 do + begin + X[j] := 0.0; + for k := 0 to M-1 do X[j] := X[j] + (A[j,k] * Y[k]); + end; + E[L] := X[0]; + Sum1 := 0.0; + for j := 0 to M-1 do + begin + V[j,L] := X[j] / X[0]; + Sum1 := Sum1 + abs(Y[j] - V[j,L]); + Y[j] := V[j,L]; + end; + if (IT - 10) <> 0 then goto nine; + if (Sum2 - Sum1) > 0 then goto nine + else + begin + showmessage('Root not converging. Exiting.'); + exit; + end; +nine: + Sum2 := Sum1; + if (Sum1 - Test) > 0 then goto three; + Sum1 := 0.0; + for j := 0 to M-1 do Sum1 := Sum1 + (V[j,L] * V[j,L]); + Sum1 := sqrt(Sum1); + for j := 0 to M-1 do V[j,L] := V[j,L] / Sum1; + for j := 0 to M-1 do + for k := 0 to M-1 do + A[j,k] := A[j,k] - (V[j,L] * V[k,L] * E[L]); + if ((M-1)-L) <= 0 then goto fifteen; + L := L + 1; + goto one; +fifteen: + Z := nil; + Y := nil; + X := nil; +end; + +procedure matinv(a, vtimesw, v, w: DblDyneMat; n: integer); +LABEL 1,2,3; + +VAR + ainverse : array of array of double; + m,mp,np,nm,l,k,j,its,i: integer; + z,y,x,scale,s,h,g,f,c,anorm: double; + rv1: array of double; + +begin + setlength(rv1,n); + setlength(ainverse,n,n); + m := n; + mp := n; + np := n; + g := 0.0; + scale := 0.0; + anorm := 0.0; + FOR i := 0 to n-1 DO BEGIN + l := i+1; + rv1[i] := scale*g; + g := 0.0; + s := 0.0; + scale := 0.0; + IF (i <= m-1) THEN BEGIN + FOR k := i to m-1 DO BEGIN + scale := scale+abs(a[k,i]) + END; + IF (scale <> 0.0) THEN BEGIN + FOR k := i to m-1 DO BEGIN + a[k,i] := a[k,i]/scale; + s := s+a[k,i]*a[k,i] + END; + f := a[i,i]; + g := -sign(sqrt(s),f); + h := f*g-s; + a[i,i] := f-g; + IF (i <> n-1) THEN BEGIN + FOR j := l to n-1 DO BEGIN + s := 0.0; + FOR k := i to m-1 DO BEGIN + s := s+a[k,i]*a[k,j] + END; + f := s/h; + FOR k := i to m-1 DO BEGIN + a[k,j] := a[k,j]+ + f*a[k,i] + END + END + END; + FOR k := i to m-1 DO BEGIN + a[k,i] := scale*a[k,i] + END + END + END; + w[i,i] := scale*g; + g := 0.0; + s := 0.0; + scale := 0.0; + IF ((i <= m-1) AND (i <> n-1)) THEN BEGIN + FOR k := l to n-1 DO BEGIN + scale := scale+abs(a[i,k]) + END; + IF (scale <> 0.0) THEN BEGIN + FOR k := l to n-1 DO BEGIN + a[i,k] := a[i,k]/scale; + s := s+a[i,k]*a[i,k] + END; + f := a[i,l]; + g := -sign(sqrt(s),f); + h := f*g-s; + a[i,l] := f-g; + FOR k := l to n-1 DO BEGIN + rv1[k] := a[i,k]/h + END; + IF (i <> m-1) THEN BEGIN + FOR j := l to m-1 DO BEGIN + s := 0.0; + FOR k := l to n-1 DO BEGIN + s := s+a[j,k]*a[i,k] + END; + FOR k := l to n-1 DO BEGIN + a[j,k] := a[j,k] + +s*rv1[k] + END + END + END; + FOR k := l to n-1 DO BEGIN + a[i,k] := scale*a[i,k] + END + END + END; + anorm := max(anorm,(abs(w[i,i])+abs(rv1[i]))) + END; + FOR i := n-1 DOWNTO 0 DO BEGIN + IF (i < n-1) THEN BEGIN + IF (g <> 0.0) THEN BEGIN + FOR j := l to n-1 DO BEGIN + v[j,i] := (a[i,j]/a[i,l])/g + END; + FOR j := l to n-1 DO BEGIN + s := 0.0; + FOR k := l to n-1 DO BEGIN + s := s+a[i,k]*v[k,j] + END; + FOR k := l to n-1 DO BEGIN + v[k,j] := v[k,j]+s*v[k,i] + END + END + END; + FOR j := l to n-1 DO BEGIN + v[i,j] := 0.0; + v[j,i] := 0.0 + END + END; + v[i,i] := 1.0; + g := rv1[i]; + l := i + END; + FOR i := n-1 DOWNTO 0 DO BEGIN + l := i+1; + g := w[i,i]; + IF (i < n-1) THEN BEGIN + FOR j := l to n-1 DO BEGIN + a[i,j] := 0.0 + END + END; + IF (g <> 0.0) THEN BEGIN + g := 1.0/g; + IF (i <> n-1) THEN BEGIN + FOR j := l to n-1 DO BEGIN + s := 0.0; + FOR k := l to m-1 DO BEGIN + s := s+a[k,i]*a[k,j] + END; + f := (s/a[i,i])*g; + FOR k := i to m-1 DO BEGIN + a[k,j] := a[k,j]+f*a[k,i] + END + END + END; + FOR j := i to m-1 DO BEGIN + a[j,i] := a[j,i]*g + END + END ELSE BEGIN + FOR j := i to m-1 DO BEGIN + a[j,i] := 0.0 + END + END; + a[i,i] := a[i,i]+1.0 + END; + FOR k := n-1 DOWNTO 0 DO BEGIN + FOR its := 1 to 30 DO BEGIN + FOR l := k DOWNTO 0 DO BEGIN + nm := l-1; + IF ((abs(rv1[l])+anorm) = anorm) THEN GOTO 2; + IF ((abs(w[nm,nm])+anorm) = anorm) THEN GOTO 1 + END; +1: c := 0.0; + s := 1.0; + FOR i := l to k DO BEGIN + f := s*rv1[i]; + IF ((abs(f)+anorm) <> anorm) THEN BEGIN + g := w[i,i]; + h := sqrt(f*f+g*g); + w[i,i] := h; + h := 1.0/h; + c := (g*h); + s := -(f*h); + FOR j := 0 to m-1 DO BEGIN + y := a[j,nm]; + z := a[j,i]; + a[j,nm] := (y*c)+(z*s); + a[j,i] := -(y*s)+(z*c) + END + END + END; +2: z := w[k,k]; + IF (l = k) THEN BEGIN + IF (z < 0.0) THEN BEGIN + w[k,k] := -z; + FOR j := 0 to n-1 DO BEGIN + v[j,k] := -v[j,k] + END + END; + GOTO 3 + END; + IF (its = 30) THEN BEGIN + showmessage('No convergence in 30 SVDCMP iterations'); + exit; + END; + x := w[l,l]; + nm := k-1; + y := w[nm,nm]; + g := rv1[nm]; + h := rv1[k]; + f := ((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y); + g := sqrt(f*f+1.0); + f := ((x-z)*(x+z)+h*((y/(f+sign(g,f)))-h))/x; + c := 1.0; + s := 1.0; + FOR j := l to nm DO BEGIN + i := j+1; + g := rv1[i]; + y := w[i,i]; + h := s*g; + g := c*g; + z := sqrt(f*f+h*h); + rv1[j] := z; + c := f/z; + s := h/z; + f := (x*c)+(g*s); + g := -(x*s)+(g*c); + h := y*s; + y := y*c; + FOR nm := 0 to n-1 DO BEGIN + x := v[nm,j]; + z := v[nm,i]; + v[nm,j] := (x*c)+(z*s); + v[nm,i] := -(x*s)+(z*c) + END; + z := sqrt(f*f+h*h); + w[j,j] := z; + IF (z <> 0.0) THEN BEGIN + z := 1.0/z; + c := f*z; + s := h*z + END; + f := (c*g)+(s*y); + x := -(s*g)+(c*y); + FOR nm := 0 to m-1 DO BEGIN + y := a[nm,j]; + z := a[nm,i]; + a[nm,j] := (y*c)+(z*s); + a[nm,i] := -(y*s)+(z*c) + END + END; + rv1[l] := 0.0; + rv1[k] := f; + w[k,k] := x + END; +3: END; +{ mat_print(m,a,'U matrix'); + mat_print(n,v,'V matrix'); + writeln(lst,'Diagonal values of W inverse matrix'); + for i := 1 to n do + write(lst,1/w[i]:6:3); + writeln(lst); } + for i := 0 to n-1 do + for j := 0 to n-1 do + begin + if w[i,i] < 1.0e-6 then vtimesw[i,j] := 0 + else vtimesw[i,j] := v[i,j] * (1.0 / w[j,j] ); + end; +{ mat_print(n,vtimesw,'V matrix times w inverse '); } + for i := 0 to m-1 do + for j := 0 to n-1 do + begin + ainverse[i,j] := 0.0; + for k := 0 to m-1 do + begin + ainverse[i,j] := ainverse[i,j] + vtimesw[i,k] * a[j,k] + end; + end; +{ mat_print(n,ainverse,'Inverse Matrix'); } + for i := 0 to n-1 do + for j := 0 to n-1 do + a[i,j] := ainverse[i,j]; + ainverse := nil; + rv1 := nil; +end; + +end. +