/* General-purpose data manipulation routines */ /* Created 21 May 92 by FJR taking IncFill, GetList and */ /* Query from PanelVC.GP */ /* */ /* Last Modified: */ /* 13 Mar 93 FJR GetList added (probably) */ /* 11 Oct 93 FJR RenewLst added; comment in IncFill */ /* UseAll/UseLast pseudo-constants */ /* 11 Feb 94 FJR Added min/maxValue to GetList */ /* 7 Mar 94 FJR Multiple versions recombined! Bits of */ /* tidying up. NB Odd code in RenewLst. */ /* 9 Mar 94 FJR Added StrCon */ /* 27 Mar 94 FJR Emended RenewLst; added Warn/Dither */ /* 8 Apr 94 FJR Allow UseAll in GetList */ /* 8 Jun 94 FJR Added Exists procedure */ /* 24 Oct 94 FJR Lower case filenames for Unix */ /* 10 Jan 95 FJR NoDelay compiler switch */ /* 18 Jun 95 FJR Removed Exists driver - see IOUtils */ /* 27 Jun 95 FJR GetList checks for UseAll/UseLast */ /* Added QryFile; took Exists from IOUtils */ /* 15 Jul 95 FJR Added QueryNN */ /* 1 Jun 96 FJR Amended Query to use a,p and BitOps */ /* Combined GetList & RenewLst; Exists */ /* now a FN; added Equal */ /* 11 Jun 97 FJR Default for GetList; have to exit now */ /* 17 Jun 97 FJR Added GetLstDL */ /* */ /* Exported: */ /* UseAll, UseLast constants */ /* IncFill (column) */ /* GetList (prompt,maxItems,minValue,maxValue,specials)*/ /* RenewLst (prompt, max, oldNum, oldList) */ /* Query (prompt, quits) */ /* QryFile (prompt, quits, ext) */ /* Find12s (data) */ /* StrCon (number) */ /* Dither */ /* Warn (text) */ /* Exists (name) */ /* Constant definitions for GetList/RenewLst */ #DEFINECS DCBit 1 /* Bits for options set */ #DEFINECS UABit 2 #DEFINECS UPBit 3 #DEFINECS UseAll "ALL" /* Options text */ #DEFINECS UsePrev "PREV" #DEFINECS DefChoix "" /* Files needing to be included: Constant.GL SelDelFR.GL Options.GL BitOps.GL */ PROC (0) = PrPrompt (prompt, options); /* Print prompt and append details of valid options */ /* In: */ /* prompt Prompt displayed to user */ /* options Allow options UseLast/UseAll/DefChoix */ PRINT prompt;; IF options/=EmptySet; PRINT " (";; ENDIF; IF TestBit (DCBit, options); PRINT " " DefChoix " ";; ENDIF; IF TestBit (UABit, options); PRINT " " UseAll " ";; ENDIF; IF TestBit (UPBit, options); PRINT " " UsePrev " ";; ENDIF; IF options/=EmptySet; PRINT ") ";; ENDIF; PRINT ": ";; ENDP; /* PrPrompt */ PROC (3) = GetList (prompt, maxItems, minValue, maxValue, oldList, defList, options, quitText); /* Re-read a list of options, allowing for reuse of an */ /* old list and selection of all items */ /* In: */ /* prompt Prompt displayed to user */ /* maxItems Max number of items to be returned */ /* minValue Minimum acceptable value */ /* maxValue Maximum acceptable value */ /* oldList Last list found */ /* defList Default list */ /* options Allow options UseLast/UseAll/DefChoix */ /* quitText Vector of quit strings */ /* Out: */ /* number Number of items read */ /* list number x 1 vector of values read */ /* anyVals Any number other than a single 0 was read */ /* NB A zero value in "oldList" will switch off 'prev' */ /* selection option; ditto defList and DefChoix */ LOCAL number; LOCAL anyVals; LOCAL list; CLEAR number, list, anyVals; IF oldList == 0; options = ClearBit(UPBit, options); ENDIF; IF defList == 0; options = ClearBit(DCBit, options); ENDIF; quitText = UPPER(quitText); PrPrompt(prompt, options); list = CONS; anyVals = NOT SUMC(UPPER(list).$==quitText); PRINT; IF NOT anyVals; number = 0; list = 0; ELSE; IF list$==""; IF TestBit(DCBit, options); PRINT "Using default..."; list = defList; ELSE; number = 0; list = 0; anyVals = False; ENDIF; ELSEIF TestBit(UABit, options) AND (UPPER(list)$==UseAll); list = SEQA (minValue, 1, maxItems); ELSEIF TestBit(UPBit, options) AND (UPPER(list)$==UsePrev); list = oldList; ELSE; list = STOF(list); anyVals = (list.>=minValue).AND(list.<=maxValue); IF SUMC(anyVals)==0; list = 0; ELSE; list = SelectR(list, anyVals); ENDIF; number = ROWS (list); IF number > maxItems; list = TRIMR (list, 0, number-maxItems); ENDIF; anyVals = (number>1) OR (list[1] /= 0); ENDIF; number = ROWS (list); ENDIF; RETP (number, list, anyVals); ENDP; /* GetList */ PROC (3) = GetLstDL (prompt, maxItems, minValue, maxValue, oldList, defList, options, quitText); /* Read a list of options, allowing for reuse of old */ /* list, defaults, selection of all items, differences */ /* and lags and leads */ /* In: */ /* prompt Prompt displayed to user */ /* maxItems Max number of items to be returned */ /* minValue Minimum acceptable value */ /* maxValue Maximum acceptable value */ /* oldList Last nx3 list found */ /* defList Default nx3 list */ /* options Allow options UseLast/UseAll/DefChoix */ /* quitText Vector of quit strings */ /* Out: */ /* number Number of items read */ /* listLD number x 3 matrix of values read */ /* anyVals Any number other than a single 0 was read */ /* NB A zero value in "oldList" will switch off 'prev' */ /* selection option; ditto defList and DefChoix */ /* "listLD" contains */ LOCAL number; LOCAL anyVals; LOCAL i; LOCAL iLD; LOCAL list; LOCAL listLD; CLEAR number, list, listLD, anyVals; IF oldList == 0; options = ClearBit(UPBit, options); ENDIF; IF defList == 0; options = ClearBit(DCBit, options); ENDIF; quitText = UPPER(quitText); PrPrompt(prompt, options); list = CONS; anyVals = NOT SUMC(UPPER(list).$==quitText); PRINT; IF NOT anyVals; number = 0; listLD = 0; ELSE; IF list$==""; IF TestBit(DCBit, options); PRINT "Using default..."; listLD = defList; ELSE; number = 0; listLD = 0; anyVals = False; ENDIF; ELSEIF TestBit(UABit, options) AND (UPPER(list)$==UseAll); listLD = SEQA (minValue, 1, maxItems); ELSEIF TestBit(UPBit, options) AND (UPPER(list)$==UsePrev); listLD = oldList; ELSE; /* need to convert space to commas */ list = STOF(CHRS(MISSRV(MISS(VALS(list),32),44))); number = ROWS(list); i = 1; iLD = 0; listLD = ZEROS(number, LagCol); DO WHILE i <= number; IF UPPER(list[i]) $=="D"; i = i + 1; IF (i>2) AND (i<=number); listLD[iLD,DiffCol] = ABS(list[i]); ENDIF; ELSEIF UPPER(list[i]) $=="S"; i = i + 1; IF (i>2) AND (i<=number); listLD[iLD,SeasCol] = list[i]; ENDIF; ELSEIF UPPER(list[i]) $=="L"; i = i + 1; IF (i>2) AND (i<=number); listLD[iLD,LagCol] = list[i]; ENDIF; ELSE; IF (list[i]>=minValue)AND(list[i]<=maxValue); iLD = iLD + 1; listLD[iLD,ItemCol] = list[i]; ENDIF; ENDIF; i = i + 1; ENDO; anyVals = iLD > 1; IF iLD ==0; listLD = 0; anyVals = False; ENDIF; number = iLD; IF number > 0; listLD = listLD[1:iLD,.]; ENDIF; IF number > maxItems; listLD = TRIMR (listLD, 0, number-maxItems); ENDIF; anyVals = (number>1) OR (listLD[1,ItemCol] /= 0); ENDIF; number = ROWS (listLD); ENDIF; RETP (number, listLD, anyVals); ENDP; /* GetList */ FN Exists (name) = /* Check to see if a file exists. Only normal files are */ /* searched for. */ /* In: */ /* name Full name of file to check */ /* Out: */ /* Exists False unless name is valid and file exists */ FILES(name, 0)/=0; /* ENDP Exists */ PROC (2) = Query (prompt, quits); /* Prompt the user for an input string. If the read text */ /* equals 'quits', the user is assumed to want to quit */ /* In: */ /* prompt Prompt string */ /* quit matrix of quit string eg ['q' | 'Q' | '0'] */ /* Out: */ /* response USer response */ /* cont quit string found */ LOCAL cont; LOCAL response; PRINT $prompt;; response = CONS; PRINT; cont = SUMC(SUMC(response .$== quits)) == 0; RETP (response, cont); ENDP; /* Query */ PROC (1) = QueryNN (prompt); /* Prompt the user for a non-null input string. */ /* In: */ /* prompt Prompt string */ /* Out: */ /* response User response */ LOCAL response; PRINT $prompt;; response = CONS; PRINT; DO WHILE response $==""; PRINT "Invalid entry: text must be non-null. Please re-enter : ";; response = CONS; PRINT; ENDO; RETP (response); ENDP; /* Query */ PROC (2) = QryFile (prompt, quits, ext); /* Prompt the user for a file name, only okaying it if */ /* the file exists. */ /* In: */ /* prompt Prompt string */ /* quit matrix of quit strings eg ['q' | 'Q' | '0'] */ /* ext File extension. Null string means none */ /* Out: */ /* response User response */ /* cont quit string found */ LOCAL cont; LOCAL response; IF ext $/= ""; ext = "." $+ ext; ENDIF; {response, cont} = Query(prompt, quits); DO WHILE cont AND NOT Exists(response$+ext); {response, cont} = Query("File does not exist; please reenter: ",quits); ENDO; RETP (response, cont); ENDP; /* QryFile */ PROC (2) = Find12s (data); /* Find 1s and 2s in a matrix; mark them with zeros and */ /* replace other values with ones */ /* In: */ /* data matrix to be checked */ /* Out: */ /* any Any 1s or 2s found */ /* data Marked */ LOCAL any; data = MISS(data, 1); data = MISS(data, 2); data = (data * 0) + 1; any = ISMISS (data); IF any; data = MISSRV(data, 0); ENDIF; RETP (any, data); ENDP; /* Find12s */ PROC(1) = StrCon(number); /* Convert a number to a string with no messing about */ /* In: */ /* number Number to be converted */ /* Out: */ /* text Number string, no dp, left just, min field */ LOCAL text; text = FTOS(number, "%*.*lf", 1, 0); RETP(text); ENDP; /* StrCon */ PROC(0) = Dither(quietly); /* Pause until keystroke, sending message to that effect */ /* In: */ /* quietly Switch output off and on again afterwards */ /** #IFUNIX PRINT; #ELSE **/ IF quietly; OUTPUT OFF; ENDIF; PRINT "Press any key to continue...";; IF NoDelay; WAIT; ELSE; WAITC; ENDIF; PRINT; IF quietly; OUTPUT ON; ENDIF; /* #ENDIF */ ENDP; /* Dither */ PROC(0) = Warn(text); /* Send warning message using lots of asterisks and things */ /* In: */ /* text Message to send */ PRINT " * * * * * P R O G R A M W A R N I N G * * * * *"; PRINT " >> " $text; PRINT " * * * * * press any key to continue * * * * *"; IF NoDelay; WAIT; ELSE; WAITC; ENDIF; ENDP; /* Warn */ PROC(1) = Equal(mat1, mat2); /* Procedure to test equality of two matrices, possibly */ /* of different sizes. */ /* In: */ /* mat1, mat2 Matrices to check */ /* Out: */ /* same False unless matrices identical */ LOCAL same; same = False; IF ROWS(mat1)==ROWS(mat2); IF COLS(mat1)==COLS(mat2); same = mat1==mat2; ENDIF; ENDIF; RETP (same); ENDP; /* Equal */ /* END DataUtil.GL */