#] #] ********************* #] loaddefs link d_Qndfs 'symbolic reduction.ndf - symbolic reduction of a general text expression # www.BillHowell.ca 15Apr2015 fresh start - not just "matrix - symbolic reduction.ndf" # view this file in a text editor, with [constant width font, tab = 3 spaces], no line-wrap # see "$d_Qtest"'symbols flatliner derivations/" : f_symRedn := 'symbolic reduction.ndf' ; loaddefs_start f_symRedn ; #**************************** # List of operators, generated with : # $ grep "^#]" "$d_Qndfs""symbolic reduction.ndf" | sed 's/^#\]/ /' # string_test_constant IS OP Str - determine if str is a constant is_zero IS OP str - tests if an expr is zero, within a tolerance of zero_tolerance is_one IS OP Str - tests if an expr is one, within a tolerance of zero_tolerance of IS OP str1 str2 - currently only used for arrays... string MUST be in parenthesis !! paren&whiteSpace IS OP Str - produces boolean list of paren&whiteSpace in a string process_string IS OP Str i - doesn't account for '' -> quote character in string process_paren IS OP Str i - tests if parenthesis are balanced append_block IS OP block_list block_now - [creates, appends] to a block_list paren_chunk IS OP txt - splits text into white-space separated text plus paren-enclosed txt parenTxt_split_by_whiteSpace IS OP Str - same as string_split_by_paren&whiteSpace, except paren-expressions non-separate append_block IS OP block_list block_now - [create, append]s to block_now parse_simple IS OP txt - extracts "zeroth-level" expressions prefix_opertr&num&Var IS OP opertr_positions replaceAll_Typ removeOne_Typ typeLst blockLst infix_opertr&num&Var IS OP typeLst blockLst - for now this simply goes left to right, opList_zero_or_one IS OP typeInParen blockInParen - takes exprn from which parenthesis have been removed mm_paren_prefix IS OP paren_positions replaceAll_Typ removeOne_Typ typeLst blockLst mm_symbolicReduction IS OP typeLst blockLst - condense an expression with constants, where this is easy symbolic_reduction IS OP txt - simplify expressions, #*********************************** # symbolic reduction.ndf - This does symbolic reduction of a general text expression # Must NOT count parenthesis within strings! (at least initial passes - interpretation is another story) # parenthesis_check IS OP stringer - 1st STEP!!! Ensures that an expression is "coherent" for later processing! # several other intermediate operators ... # # oprtn expr_seq closr := opn_exprns_parse str_opn_exprns_closr - produces "standard" multi-line aligned listing of an expression, that is easier to read # - opns in form '(text ' # - expressions (in expr_seq list) are lists of two types of text separated by spaces : # 1. sequences of non-space characters # 2. parenthesis matched enclosed text that may contain spaces # - closer (closr) is ')' # # zero_out IS OP str_opn_exprns_closr - removes zeroed expressions #*********************************** # Debugging # IF flag_break_symRedn THEN Break ; ENDIF ; # Reminder - these are defined in "Start tools.ndf", profile.ndf flag_break_symRedn := o ; % stop execution to test local environment ; flag_check := o ; % force checking of all operators with examples, showing results ; flag_debug_parenChk := o ; % see profile.ndf ; flag_debug_symRedn := o ; % routine checks, localisation ; flag_print := o ; % print results to screen during loading ; # IF flag_break = l THEN Break ; ENDIF ; # IF flag_print = l THEN <... coding for printout ...> ; ENDIF ; # IF flag_debug = l THEN write 'loadCheck starting ' ; ENDIF ; # program_break IS { IF flag_break = l THEN Break ; ENDIF ; } # Faults occur normally during searches, and must not stop execution! # settrigger o ; # watch : awesome eQNial power!! X gets count 5; watch !x 'write ''X changed to: '' X' # #*********************************** # Setup # Defined in Qnial/profile.ndf # Qnial_root := '/media/bill/SWAPPER/Qnial/' ; # d_Qndfs := '/media/bill/SWAPPER/Qnial/MY_NDFS/' ; # tostring_sep A S - converts a list of reals to a string with reals separated by a specified string # string_base IS OP A - applies "string to an array A, assumes at "lowest level" (atomic or string) # array_of_strings IS OP A - uses "string_base to convert all LEAFs of A to strings IF not in "TOSTRING_SEP (EACH first symbols 0) THEN loaddefs (link d_Qndfs 'strings.ndf') 0 ; ENDIF; spaces_flag := l ; whitespace := char_tab char_newline char_carriagereturn char_space ; #*********************************** # Coding # Like QNial - this will treat all expressions equally : NO prioritization, distribution, commutation etc #***************************** # Initialisation IF flag_debug THEN write 'loading Initialisation' ; ENDIF ; syms_total typs_total syms_Howell typs_Howell := 0 0 0 0 ; #] symbols&Identifiers IS - symbols&Identifiers IS { NONLOCAL syms_total typs_total syms_Howell typs_Howell ; syms_total typs_total := cols mix symbols 1 ; syms_Howell := first cols mix symbols 0 ; typs_Howell := typs_total ; i := 0 ; FOR j WITH tell gage shape syms_total DO IF = syms_total@j syms_Howell@i THEN typs_Howell@j := l ; i := i + 1 ; ELSE typs_Howell@j := o ; ENDIF ; ENDFOR ; } symbols&Identifiers ; # check to make sure that ALL types have phrase labels IF (AND (EACH isphrase typs_total)) THEN write 'symbolic reduction.ndf: ALL symbols type labels are phrases (OK)' ; ELSE write 'symbolic reduction.ndf: ERROR - NOT ALL symbols type labels are phrases (OK)' ; ENDIF ; view_s&I IS transpose mix syms_total typs_total typs_Howell #**************************** # basic operators IF flag_debug THEN write 'loading basic operators' ; ENDIF ; #] string_test_constant IS OP Str - determine if str is a constant # Note the arbitrary "zero band" of 1e-6, which will be incorrect for any problem # with numbers in that range or smaller (I.e. much or real world!!) is_constantStr IS OP Str { %17Apr2016 ignores complex numbers for now, problem if all chars are whitespace ; IF (NOT isstring Str) THEN result := fault '?string_test_constant error: input is NOT a string' ; ELSE constant_chars := '+-0123456789.e' ; %no complex #'s for now ; strLen := gage shape str ; strflags := strLen reshape o ; FOR i WITH tell strLen DO IF (Str@i in constant_chars) THEN strflags@i := l ; ELSE strflags@i := o ; EXIT null ; ENDIF ; ENDFOR ; result := AND strflags ; %Pragmatic simple double-check - see if execute str is [integer,real,complex] (not complex yet!) ; IF result THEN IF (NOT OR [isinteger, isreal] (execute Str)) THEN result := o ; ENDIF ; ENDIF ; ENDIF ; result } #] is_zero IS OP str - tests if an expr is zero, within a tolerance of zero_tolerance # (DANGEROUS - depends on problem!!!) zero_tolerance := 1e-6 ; is_zero IS OP Str { result := o ; IF is_constantStr Str THEN constantNumber := execute Str ; IF (AND ((-1*zero_tolerance) <= constantNumber) (constantNumber <= zero_tolerance)) THEN result := l ; ENDIF ; ENDIF ; result } #] is_one IS OP Str - tests if an expr is one, within a tolerance of zero_tolerance # needs to handle -1 as well!!! # (DANGEROUS - depends on problem!!!) is_one IS OP Str { result := o ; IF is_constantStr Str THEN constantNumber := abs execute Str ; IF (AND ((-1*zero_tolerance + 1) <= constantNumber) (constantNumber <= (1 + zero_tolerance))) THEN result := l ; ENDIF ; ENDIF ; result } IF flag_debug = l THEN write 'loading varName&Index' ; ENDIF ; varName&Index IS OP Str { at_signPosn := find_Howell `@ Str ; varName := tell at_signPosn choose Str ; indexName_list := null ; in_indexName := o ; indexName_current := ' ' ; FOR i WITH (at_signPosn + 1 + tell (gage shape Str - at_signPosn + 1)) DO IF (in Str@i (`[ `, ` `]) ) THEN IF in_indexName THEN indexName_list := indexName_list link indexName_current ; indexName_current := ' ' ; in_indexName := o ; ENDIF ; ELSE IF NOT in_indexName THEN in_indexName := l ; ENDIF ; indexName_current := indexName_current link Str@i ; ENDIF ; ENDFOR ; varName indexName_list } #] of IS OP str1 str2 - currently only used for arrays... string MUST be in parenthesis !! IF flag_debug = l THEN write 'loading of' ; ENDIF ; of IS OP str { str1 str2 str3 := '' '' '' ; %in_str1 in_of in_str2 := loo ; % first get host array ; IF flag_break = l THEN Break ; ENDIF ; IF (NOT AND (= `( (first str)) (= `) (last str))) THEN fault 'function of: string input doesn''t start and end with parenthesis' ELSE FOR i WITH tell gage shape str DO IF (= Str@i `( ) THEN null ; ELSEIF (= Str@i `] ) THEN str1 := str1 link Str@i ; EXIT null ; ELSE str1 := str1 link Str@i ; ENDIF ; ENDFOR ; FOR j WITH i + 1 + tell (gage shape str - i) DO IF (NOT in Str@j whitespace) THEN str2 := str2 link Str@j ; ENDIF ; IF (= 'of' str2) THEN EXIT null ; ENDIF ; ENDFOR ; FOR k WITH j + 1 + tell (gage shape str - j) DO IF (= Str@k `) ) THEN EXIT null ; ELSE str3 := str3 link Str@k ; ENDIF ; ENDFOR ; of_func := link (first varName&Index str1) '_func' ; strip_extra_whitespace link 'execute ''' str1 ' := ' of_func ' ' str3 ' '' ' ENDIF } IF flag_debug THEN write 'loading paren&whiteSpace' ; ENDIF ; #] paren&whiteSpace IS OP Str - produces boolean list of paren&whiteSpace in a string paren&whiteSpace IS OP Str { NONLOCAL char_tab char_newline char_carriagereturn char_space ; %charrep_list := each charrep Str ; test_char_tab := link (char_tab EACHRIGHT match Str ) ; test_char_newline := link (char_newline EACHRIGHT match Str ) ; test_char_carriagereturn := link (char_carriagereturn EACHRIGHT match Str ) ; test_char_space := link (char_space EACHRIGHT match Str ) ; test_char_parenLeft := link (`( EACHRIGHT match Str ) ; test_char_parenRght := link (`) EACHRIGHT match Str ) ; OR test_char_newline test_char_carriagereturn test_char_space test_char_parenLeft test_char_parenRght } IF flag_debug THEN write 'loading process_string' ; ENDIF ; #] process_string IS OP Str i - doesn't account for '' -> quote character in string # 15Apr2016 process_string IS OP Str i { result := 0 'process_string error: oops' ; quote_count := 1 ; FOR j WITH (i + 1 + tell (tally Str - i)) DO IF (= `' Str@j) THEN result := j Str|[i + tell (j - i +1)] ; EXIT null ; ENDIF ; ENDFOR ; result } # IF flag_break_symRedn = l THEN Break ; ENDIF ; #] process_paren IS OP Str i - tests if parenthesis are balanced # 15Apr2016 got it working # what about "no closure" of parenthesis? process_paren IS OP Str i { result := 0 'process_paren error: oops' ; paren_count := 0 ; FOR j WITH (i + tell (tally Str - i)) DO IF (= `( Str@j) THEN paren_count := paren_count + 1 ; ELSEIF (= `) Str@j) THEN paren_count := paren_count - 1 ; IF (= 0 paren_count) THEN result := j Str|[i + tell (j - i +1)] ; EXIT null ; ENDIF ; ENDIF ; ENDFOR ; result } # *************************** #] append_block IS OP block_list block_now - [creates, appends] to a block_list Howell routine each segment starts with S1 need recursive definition if S1 doesn't appear - returns entire S2 # see 'cuttext.ndf' from QNial library above IF flag_debug THEN write 'loading string_split_by_paren&whiteSpace' ; ENDIF ; append_block IS OP block_list block_now { IF = null block_now THEN block_list ELSE block_list append block_now ENDIF } # IF flag_break_symRedn = l THEN Break ; ENDIF ; string_split_by_paren&whiteSpace IS OP Str { LOCAL i_str ; NONLOCAL char_tab char_newline char_carriagereturn char_space whitespace ; str_length := tally Str ; type_list := "start ; block_now := '' ; block_list := solitary '' ; in_string in_paren in_white in_operator in_text flag_error_symRedn := o o l o o o ; i_str := 0 ; i_return := 0 ; REPEAT IF (Str@i_str = `') THEN block_list := append_block block_list block_now ; i_return block_now := process_string Str i_str ; % what if string not "closed"? ; %write 'from paren : ' i_return block_now ; IF (= block_now 'process_string error: oops') THEN flag_error_symRedn := l ; ENDIF ; type_list := type_list append "string ; block_list := append_block block_list block_now ; block_now := '' ; in_white in_text := o o ; ELSEIF (Str@i_str = `() THEN block_list := append_block block_list block_now ; i_return block_now := process_paren Str i_str ; % what if paren not "closed"? ; IF (= block_now 'process_paren error: oops') THEN flag_error_symRedn := l ; ENDIF ; type_list := type_list append "paren ; block_list := append_block block_list block_now ; block_now := '' ; in_white in_text := o o ; ELSEIF (Str@i_str in (`+ `* `/)) THEN block_list := append_block block_list block_now ; type_list := type_list append "opertr ; block_list := append_block block_list (string Str@i_str) ; block_now := '' ; in_white in_text := o o ; ELSEIF (Str@i_str in (`- )) THEN block_list := append_block block_list block_now ; IF ((i_str + 1) < str_length) THEN IF (Str@(i_str + 1) in whitespace) THEN type_list := type_list append "opertr ; block_list := append_block block_list (string Str@i_str) ; block_now := '' ; in_white in_text := o o ; ELSE % --->>> same as below !! This time for "-" as "opp" in a text-type ; IF in_white THEN type_list := type_list append "text ; block_now := string Str@i_str ; in_white in_text := o l ; ELSEIF in_text THEN block_now := block_now link Str@i_str ; in_white in_text := o l ; ELSEIF (NOT OR in_white in_text) THEN type_list := type_list append "text ; block_now := string Str@i_str ; in_white in_text := o l ; ELSE flag_error_symRedn := l ; write 'string_split_by_paren&whiteSpace error: unknown situation for "-" sign in_white & in_text' ; ENDIF ; % <<<--- same as below !! ; ENDIF ; ENDIF ; ELSEIF ((string Str@i_str) in whitespace) THEN IF NOT in_white THEN block_list := append_block block_list block_now ; type_list := type_list append "space ; block_list := append_block block_list ' ' ; block_now := '' ; in_white in_text := l o ; ENDIF ; ELSE IF in_white THEN type_list := type_list append "text ; block_now := string Str@i_str ; in_white in_text := o l ; ELSEIF in_text THEN block_now := block_now link Str@i_str ; in_white in_text := o l ; ELSEIF (NOT OR in_white in_text) THEN type_list := type_list append "text ; block_now := string Str@i_str ; in_white in_text := o l ; ELSE flag_error_symRedn := l ; write 'string_split_by_paren&whiteSpace error: unknown situation for in_white & in_text' ; ENDIF ; ENDIF ; %write post type_list block_list block_now (i_str i_return) ; IF (~= i_str i_return) THEN i_str := i_return ; ENDIF ; i_str := i_str + 1 ; i_return := i_str ; UNTIL (OR (= str_length i_str) flag_error_symRedn) ENDREPEAT ; (rest type_list) (rest append_block block_list block_now) } IF flag_debug THEN write 'loading paren_chunk' ; ENDIF ; view_type&block IS OP type&block_result { transpose mix type&block_result } #] paren_chunk IS OP txt - splits text into white-space separated text plus paren-enclosed txt # This should IGNORE parenthesis within strings!! (for now) # paren_chunk IS OP txt { txt := strip_extra_whitespace txt ; classes chunks := string_split_by_paren&whiteSpace txt ; } IF flag_debug THEN write 'loading parenTxt_split_by_whiteSpace' ; ENDIF ; #] parenTxt_split_by_whiteSpace IS OP Str - same as string_split_by_paren&whiteSpace, except paren-expressions non-separate # 21Apr2016 # IF flag_break_symRedn = l THEN Break ; ENDIF ; parenTxt_split_by_whiteSpace IS OP Str { LOCAL i_str ; NONLOCAL char_tab char_newline char_carriagereturn char_space whitespace ; str_length := tally Str ; type_list := "start ; block_now := '' ; block_list := solitary '' ; in_string in_paren in_white in_operator in_text flag_error_symRedn := o o l o o o ; i_str := 0 ; i_return := 0 ; REPEAT IF (Str@i_str = `') THEN block_list := append_block block_list block_now ; i_return block_now := process_string Str i_str ; % what if string not "closed"? ; %write 'from paren : ' i_return block_now ; IF (= block_now 'process_string error: oops') THEN flag_error_symRedn := l ; ENDIF ; type_list := type_list append "string ; block_list := append_block block_list block_now ; block_now := '' ; in_white in_text := o o ; ELSEIF (Str@i_str in (`+ `* `/)) THEN block_list := append_block block_list block_now ; type_list := type_list append "opertr ; block_list := append_block block_list (string Str@i_str) ; block_now := '' ; in_white in_text := o o ; ELSEIF (Str@i_str in (`- )) THEN block_list := append_block block_list block_now ; IF ((i_str + 1) < str_length) THEN IF (Str@(i_str + 1) in whitespace) THEN type_list := type_list append "opertr ; block_list := append_block block_list (string Str@i_str) ; block_now := '' ; in_white in_text := o o ; ELSE % --->>> same as below !! This time for "-" as "opp" in a text-type ; IF in_white THEN type_list := type_list append "text ; block_now := string Str@i_str ; in_white in_text := o l ; ELSEIF in_text THEN block_now := block_now link Str@i_str ; in_white in_text := o l ; ELSEIF (NOT OR in_white in_text) THEN type_list := type_list append "text ; block_now := string Str@i_str ; in_white in_text := o l ; ELSE flag_error_symRedn := l ; write 'string_split_by_paren&whiteSpace error: unknown situation for "-" sign in_white & in_text' ; ENDIF ; % <<<--- same as below !! ; ENDIF ; ENDIF ; ELSEIF ((string Str@i_str) in whitespace) THEN IF NOT in_white THEN block_list := append_block block_list block_now ; type_list := type_list append "space ; block_list := append_block block_list ' ' ; block_now := '' ; in_white in_text := l o ; ENDIF ; ELSE IF in_white THEN type_list := type_list append "text ; block_now := string Str@i_str ; in_white in_text := o l ; ELSEIF in_text THEN block_now := block_now link Str@i_str ; in_white in_text := o l ; ELSEIF (NOT OR in_white in_text) THEN type_list := type_list append "text ; block_now := string Str@i_str ; in_white in_text := o l ; ELSE flag_error_symRedn := l ; write 'string_split_by_paren&whiteSpace error: unknown situation for in_white & in_text' ; ENDIF ; ENDIF ; %write post type_list block_list block_now (i_str i_return) ; IF (~= i_str i_return) THEN i_str := i_return ; ENDIF ; i_str := i_str + 1 ; i_return := i_str ; UNTIL (OR (= str_length i_str) flag_error_symRedn) ENDREPEAT ; (rest type_list) (rest append_block block_list block_now) } #] append_block IS OP block_list block_now - [create, append]s to block_now append_block IS OP block_list block_now { IF = null block_now THEN block_list ELSE block_list append block_now ENDIF } #**************************** # type_text - key classification of "text_blocks" IF flag_debug THEN write 'loading type_text' ; ENDIF ; type_text IS OP typeLst blockLst { NONLOCAL syms_total typs_total ; txt_positions := findall "text typeLst ; FOR i WITH (tell gage shape txt_positions) DO j := txt_positions@i ; IF (is_constantStr blockLst@j) THEN IF is_zero blockLst@j THEN typeLst@j := "zero ; ELSEIF is_one blockLst@j THEN typeLst@j := "one ; ELSE typeLst@j := "number ; ENDIF ; ELSEIF (= `" (first blockLst@j)) THEN typeLst@j := "phrase ; ELSEIF (NOT isfault (k := find_Howell (phrase toupper blockLst@j) syms_total)) THEN typeLst@j := typs_total@k ; ENDIF ; ENDFOR ; typeLst blockLst } #**************************** IF flag_debug THEN write 'loading parse_simple' ; ENDIF ; #] parse_simple IS OP txt - extracts "zeroth-level" expressions # for immediate [collapse, remove single terms] or for further depth analysis # first simple assumption - parenthetical expressions are "kept out" for deeper processing # but this still allows decisions based on retained expressions (eg - multiply by zero) # # Produce # Start by modifying type_list for all text chunks # Search text in type_list ,execute values] changes for [integer, real] (type := "real) # Test for zeros or ones # zeros include 0 00 000 0.00 etc (i.e. absolute ( 0 - (execute string) ) < 1e-3, for example) # ones - sames threshold-type test # IF there are zeros or ones : # check if any text are [reserved,transformers,operators] in (first symbols 1) # using their type from (second symbols 1) # -> change their "text to "operatr in type_list # Simple approach : # IF (AND (ALL operators are in [+,-,*,/]) (ALL text are reals)) # simply execute the expression! # IF '*' is the ONLY operator, then # IF zero is a text -> the whole expression returns zero # IF one is a text -> the one may be removed, possibly the '*' as well # IF '+' is the ONLY operator, then # IF zero is a text -> the zero may be removed, possibly the '+' as well # IF one is a text -> not change # Once the first pass is done # return the reduced expression within parenthesis (important for nexted structures) # check for embeded paren expressions # IF paren operator same as ONLY SINGLE host expression operator [*,+] # THEN splice parsed paren-expression into mother expression, removing paren operator # later thoughts ... # how to accurately, simply] deal with [infix, prefix, pervasive] properties? # zeros - see if they are surounded by [+,-,/,*] operators # [+,-] - flag type for removal IF there are NO preceding text that might be operators # ones - see if they are surounded by [/,*] operators (but NOT [+,-]) # parse_simple IS OP txt { exprs_simple := string_split_by_paren&whiteSpace txt ; } #] prefix_opertr&num&Var IS OP opertr_positions replaceAll_Typ removeOne_Typ typeLst blockLst # This is for general expressions interpreted by prefix rules (perator forllow by args) # (i.i it is not just for prefix parenthetical expressions!). IF flag_debug = l THEN write 'loading prefix_opertr&num&Var' ; ENDIF ; prefix_opertr&num&Var IS OP opertr_positions replaceAll_Typ removeOne_Typ typeLst blockLst { FOR i WITH opertr_positions DO lstLength := gage shape typeLst ; subLister := lstLength reshape l ; FOR j WITH (i + 1 + tell (lstLength - i - 1)) DO IF (NOT (OR (typeLst@j EACHRIGHT = "number "one "space "var "zero))) THEN j := j - 1 ; EXIT null ; ENDIF ; ENDFOR ; tmpChoose := i + tell (j - i + 1) ; typeTmp := tmpChoose choose typeLst ; IF flag_break_symRedn = l THEN break ; ENDIF ; % for multiplication - replace entire sequence with zero if a "zero is present, remove only the "one if present ; % for addition - remove only the "zero if present ; IF (in replaceAll_Typ typeTmp) THEN subLister := ((gage shape tmpChoose) reshape o) tmpChoose placeall subLister ; ELSEIF (NOT (= null (type_positions := findall removeOne_Typ typeTmp))) THEN subLister := ((gage shape type_positions) reshape o) (i + type_positions) placeall subLister ; ENDIF ; typeLst blockLst := subLister EACHRIGHT sublist typeLst blockLst ; ENDFOR ; typeLst blockLst } # 19Apr2016 - infix_table was created in anticipations of much more thorough semantic processing, # and is not used for now in_white in_text in_plus in_minus in_times in_divide := oooooo ; infix_table := 65 8 reshape 'stat\phrs' "tr "op "opertr "number "one "space "zero (oooooo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oooool) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oooolo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (ooooll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oooloo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (ooolol) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (ooollo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (ooolll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oolooo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oolool) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oololo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oololl) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oolloo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oollol) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oolllo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oollll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oloooo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oloool) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (oloolo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (olooll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (ololoo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (ololol) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (olollo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (ololll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (ollooo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (ollool) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (ollolo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (olloll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (ollloo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (olllol) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (ollllo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (olllll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (looooo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (looool) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (looolo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (loooll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (looloo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (loolol) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (loollo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (loolll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lolooo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lolool) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lololo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lololl) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lolloo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lollol) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lolllo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lollll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lloooo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lloool) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lloolo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (llooll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lloloo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (llolol) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (llollo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (llolll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lllooo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lllool) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lllolo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (llloll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lllloo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (llllol) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (lllllo) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' (llllll) 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' 'pass ' ; valid_states := rest infix_table|[,0] ; valid_phrases := rest infix_table|[0,] ; view_states IS mix ("in_white "in_text "in_plus "in_minus "in_times "in_divide ) ( in_white in_text in_plus in_minus in_times in_divide ) #] infix_opertr&num&Var IS OP typeLst blockLst - for now this simply goes left to right, # handling ONLY pairs of data # # IF flag_debug = l THEN write 'loading infix_opertr&num&Var' ; ENDIF ; # infix_opertr&num&Var IS OP typeLst blockLst { typeStack blockStack tranStack varStack := null null ; in_data in_transformer&Operator in_plus in_minus in_times in_divide := oooooo ; lstLength := gage shape typeLst ; FOR i WITH tell lstLength DO IF (= "space typeLst@i) THEN null ; ELSEIF (typeLst@i in (" )) THEN # #] opList_zero_or_one IS OP typeInParen blockInParen - takes exprn from which parenthesis have been removed # For any opertr preceding a list of one item : # + gives that item eg (+ 7) = 7 # - gives (opp item) eg (- 7) = -7 # * gives that item eg (* 7) = 7 # / item gives reciprocal eg (/ 7) = 1/7 # item / gives that item eg (7 /) = 7 # Check for empty prefix expressions - i.e. one or zero data types ; # Prefix ASSUMES that an expression results from matrix ops [mas,mds,mms,mss] - so there are no ; # "floating" [tr, op, opertr, etc] between parenthetical terms. (I need a test for that!) ; # Warning : [expr, op] can yield data with no data input! ; # operator labels are (QNial) : ["expr "ident "op "res "tr "var] ; # (Howell) : ["number "one "opertr "paren "phrase "space "text "zero] ; # where "opertr in [+,-,*,/] ; IF flag_debug = l THEN write 'loading opList_zero_or_one' ; ENDIF ; opList_zero_or_one IS OP typeInParen blockInParen { IF (OR (is_plus is_minus is_times is_divide := '+' '-' '*' '/' EACHLEFT = (first blockInParen)) ) THEN typeRem blockRem := EACH rest typeInParen blockInParen ; spaceLess := NOT ("space EACHRIGHT = typeRem) ; IF (1 = (sum spaceLess)) THEN typeInParen blockInParen := spaceLess EACHRIGHT sublist typeRem blockRem ; IF is_minus THEN blockInParen := solitary (link '((-1)*' (first blockInParen) ')') ; ENDIF ; ELSEIF (0 = (sum spaceLess)) THEN IF (OR is_times is_divide) THEN typeInParen blockInParen := "one (solitary '1') ; ELSE typeInParen blockInParen := "zero (solitary '0') ; ENDIF ; ENDIF ; ENDIF ; typeInParen blockInParen } #****************************** #] mm_paren_prefix IS OP paren_positions replaceAll_Typ removeOne_Typ typeLst blockLst # This is specifically for replacing a "paren (parenthesis-surrounded) block of text as previously # identified by string_split_by_paren&whiteSpace, with either a slightly modified "paren, # or by a simple text result (example : replace paren by zero if the "paren is of # pattern "(* 4 3 6 var 0 34 )" ). # I should add checks to make sure that : # ONLY types ["opertr, "number, "zero, "one, "space] are present # paren_txt starts & ends with parenthesis # etc, etc, etc, IF (AND (= '(' (first paren_txt)) # (= ')' (last paren_txt)) # # ['-','/'] = (mds,nss) have to be properly handled - later... ; # Currently - not pervasive so will do first pair, then lik a list ; # IF flag_break_symRedn = l THEN break ; ENDIF ; IF flag_debug = l THEN write 'loading mm_paren_prefix' ; ENDIF ; mm_paren_prefix IS OP paren_txt { paren_tmp := front rest paren_txt ; typeInParen blockInParen := type_text string_split_by_paren&whiteSpace paren_tmp ; IF (OR (('*' '/') EACHLEFT = blockInParen@0)) THEN IF (in "zero typeInParen) THEN typeInParen blockInParen := "zero (solitary '0') ; ELSEIF (NOT (= null (one_positions := findall "one typeInParen))) THEN IF flag_break_symRedn = l THEN break ; ENDIF ; % retain only the first of however many "ones there are ; data_count := gage shape link ("number "one "phrase "text "zero "var EACHLEFT findall typeInParen) ; IF (data_count > 1) THEN sublister := gage shape typeInParen reshape l ; sublister := (gage shape one_positions reshape o) one_positions placeall sublister ; typeInParen blockInParen := subLister EACHRIGHT sublist typeInParen blockInParen ; ENDIF ; ENDIF ; ELSEIF (OR (('+' '-') EACHLEFT = blockInParen@0)) THEN IF (NOT AND (subLister := NOT ("zero EACHRIGHT = typeInParen))) THEN typeInParen blockInParen := subLister EACHRIGHT sublist typeInParen blockInParen ; ENDIF ; ENDIF ; typeInParen blockInParen := opList_zero_or_one typeInParen blockInParen ; IF (OR (1 null EACHLEFT = (gage shape typeInParen))) THEN typeInParen blockInParen ELSE "paren (solitary strip_extra_whitespace link link '(' blockInParen ')' ) ENDIF } IF flag_debug = l THEN write 'loading mm_symbolicReduction' ; ENDIF ; #] mm_symbolicReduction IS OP typeLst blockLst - condense an expression with constants, where this is easy # start with "operator sequences" labelled with "opertr" (i.e. [+,-,*,/]) that contain zero or one, # operator labels are (QNial) : ["expr "ident "op "res "tr "var]; # (Howell) : ["number "one "opertr "paren "phrase "space "text "zero] # where "opertr in [+,-,*,/] # addition, multiplication] are ?pervasive, pervading? in QNial # problem with minus sign "-" - is it the "minus" operator or "opposite" operator?? % First, check if the whole expression is easily executed as first pass ; % This means that the typeLst contains ONLY ["tr "op "opertr "number "one "space "var "zero] types ; % Later iterations can address ["var "paren "string "text etc etc] ; % ELSEIFs currently ONLY deal with 'prefix' format such as : ; % 'opertr [[space number],[space,one],[space,var],[space,zero]]' ; % For now, it is assumed to only occur (for now!) when [+,-,*,/] immediately follow a left parenthesis '('. ; % It looks like code sections can be readily generalized!... ; mm_symbolicReduction IS OP expression_in { % If the expression contains no variables (just numbers including "zero and "one), then execute ; IF flag_break_symRedn = l THEN break ; ENDIF ; typeLst blockLst := type_text string_split_by_paren&whiteSpace expression_in ; IF (AND OR (typeLst EACHLEFT in "tr "op "opertr "number "one "space "zero)) THEN typeLst blockLst := "text (LEAF string execute link blockLst) ; % 28Apr2016 - error: jams number sequences no spaces ; % Simplify 1st level only of "parens ; ELSEIF (NOT (= null (paren_positions := findall "paren typeLst))) THEN FOR i WITH paren_positions DO typeInParens blockInParen := mm_paren_prefix blockLst@i ; typeLst@i := typeInParens ; blockLst@i := blockInParen ; ENDFOR ; ELSE % infix notation in NOT done if "parens are outstanding ; % (paired only!!) for non-matrix-multiply situations (this won't work in many cases !!) ; % typeLst blockLst := infix_opertr&num&Var typeLst blockLst ; % prefix_opertr&num&Var - this too... ; ENDIF ; strip_extra_whitespace link link blockLst } # strip_extra_whitespace link link blockLst #21Apr2016 - LEAF may cause a problems with concatenated items in lists? typeLst blockLst := EACH solitary "text (LEAF string execute link blockLst) ; # 21Apr2016 WRONG results !!!! test_mm_symbolicReduction IS { EACH [write, write transpose mix mm_symbolicReduction type_text string_split_by_paren&whiteSpace] '(* 3 2 -6 1 3 4 - 45)' '(+ 3 2 -6 0 3 4 - 45)' ; } # ~17Apr2016 ?segmentation fault? # 21Apr2016 - no longer a problem - just returns ?conform fault as it should test_mm_symbolicReduction IS { [write, write transpose mix mm_symbolicReduction type_text string_split_by_paren&whiteSpace] 'a@[5,0] * 0 1 a 3 + 15 power 3 4' ; } #] symbolic_reduction IS OP txt - simplify expressions, # currently : # collapses [multiplication : zeros] # removes single term [multiplication : 1; addition : 0] # Does NOT yet : # handle expression evaluations IF flag_break_symRedn THEN write 'loading symbolic_reduction' ; ENDIF ; # symbolic_reduction IS OP txt { IF (NOT isstring txt) THEN 'symbolic_reduction error: non-text input' ELSE IF (NOT parenthesis_check txt) THEN 'symbolic_reduction error: unbalanced parenthesis' ELSE ??? := parse_simple txt ; ENDIF ENDIF } #*********************** # post-program loaddefs # application - see : /media/bill/SWAPPER/Qnial/MY_NDFS/symbolic reduction - examples.ndf loaddefs_ended f_symRedn ; # enddoc