- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Pierce (2020) illustrated the use of analysis of functions beyond the first order using some number theory examples. We are interested in the functions represented by parabolic and higher order systems that can be reasonably represented by simple Fourier series. As an example, the gamma constant in the standard COVID model is in reality a simple Fourier series with at least two terms. The analysis of non-stationary time series relies on this type of analysis.
-------------------------------------------------------------------------------------------------------------------
Using Fortran is always a problem, you mean that old language, and then Pierce from Duke Uni does not return emails so I am making some assumptions from a paper I cannot find again. I read her papers and then I bash my head against the wall till the pain stops.
Write a AI program in Fortran for rule based system to analyse second order general ODE's from non-stationary time series in near real time. Easy --
Link Copied
3 Replies
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The key technical challenges are implementation of a LISP AI like system in Intel Fortran. It must be considered unusual that this has not already been completed as the PI implemented the first AI system in AutoCAD using Auto LISP which has a very limited function set required for AI code and required about 6 months to develop the code. This program was first published at an AutoCAD Conference in Sydney in 1988. This significant technical challenge will mitigate the need for interfacing an interpreted language such as Python or LISP to Fortran, which the PI considers will be significantly more klutzy than developing FORTRAN with a few LISP like extensions.
---------------------------------------------------------------------------------------------------------
The question is not can it be done, the question is how hard will it be.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
; THIS IS AI SECTION OF THE SEWER PROGRAMME
(vmon)
;The programme section is divided into a number of levels to allow easy
;maintence Level 1 contains the procedures called from the command file
; Level 2 contains the procedures called by L 1 and uses L3 procedures.
; Level 3 contains the bulk of the procedures not using primitives
; except to control flow
; Level 4 contains the procedures built from primitives and always
; called from a higher level
; LEVEL 1 PROCEDURES
(defun firststage ()
(setq flag 1)
(initialize_rule_base)
(initialize-rules)
(forward-chain)
)
; LEVEL 2 PROCEDURES
; LEVEL 3 PROCEDURES
; LEVEL 4 PROCEDURES
(defun colorp(word)
(member word '(red white blue yellow))
)
; a function to match lists borrowed from WINSTON with thanks
(defun match (p d assignments)
; (print " p d assignments")
; (print p)
; (print d)
; (print assignments)
(cond ((and (null p) (null d))
(cond ((null assignments) T)
( T assignments)
)
)
((or (null p) (null d)) nil)
((or ( equal (car p) '?)
( equal (car p) (car d))
)
(match (cdr p) (cdr d) ;changed here
assignments
)
)
(( equal (car p) '+)
( or (match (cdr p ) (cdr d) assignments)
(match p (cdr d) assignments)
)
)
((atom (car p)) nil)
((equal (pattern-indicator (car p)) '>)
(match (cdr p) (cdr d)
(shove-gr (pattern-variable (car p))
(car d)
assignments
)
)
)
; (cond ((and (equal (pattern-indicator (car p)) '<)
; (null (cdr d))
; )(setq p nil)
; )
; )
((equal (pattern-indicator (car p)) '<)
(match ( cons ( pull-value ( pattern-variable ( car p)) assignments)
(cdr p))
d
assignments
)
)
((equal (pattern-indicator (car p )) '+)
(setq new-assignments ( shove-pl ( pattern-variable ( car p ))
( car d )
assignments
)
)
(or ( match (cdr p) (cdr d) new-assignments)
( match p (cdr d) new-assignments)
)
)
((and ( equal (pattern-indicator (car p)) 'restrict )
( equal (restriction-indicator (car p)) '?)
( test (restriction-predicates (car p))(car d))
)
(match (cdr p) (cdr d) assignments)
)
((equal (pattern-indicator (car p)) '<+)
(match (append (pull-value (pattern-variable (car p)) assignments)
(cdr p)
) d assignments
)
)
)
)
(defun shove-gr ( variable item a-list)
(append a-list (list (list variable item)))
)
(defun pattern-indicator ( l)
(car l)
)
(defun pattern-variable (l)
(cadr l)
)
(defun pull-value (variable a-list)
(cadr (assoc variable a-list))
)
(defun shove-pl (variable item a-list)
(cond((null a-list)(list (list variable (list item))))
((equal variable (caar a-list))
(cons (list variable (append (cadar a-list)(list item)))
(cdr a-list)))
(T (cons (car a-list)
(shove-pl variable item (cdr a-list))))
)
)
(defun restriction-indicator (pattern-item)
(cadr pattern-item)
)
(defun restriction-predicates (pattern-item)
(cddr pattern-item)
)
(defun test (predicates arguments )
(setq arg-list (list arguments))
(cond ((null predicates) T)
((apply (car predicates ) arg-list)
(test (cdr predicates) arguments)
)
( T nil)
)
)
(defun funcall ( function-name value )
(setq function-name function-name)
(function-name value)
)
(defun remember (new)
(print "at remember")
(print "new")
(print new)
(setq q1 new)
(setq rule-base (make_rule_base q1))
(cond( (member new assertions ) (write-line "THIS PROCEDURE IS NOTR"))
(T (setq assertions (cons new assertions)))
)
(print "new assertions")
(print assertions)
)
(defun initialize_rule_base ()
(setq nta 1)
(setq rule-base
(list
(list '1
(list 'This 'is 'rule 'base)
)
)
)
)
(defun make_rule_base ( q2)
(print "at rule base")
(setq nta (1+ nta))
(print q2)
(setq block
(append rule-base
(append
(list
(list
nta
q2
)
)
)
)
)
)
(defun combine-streams (s1 s2 )
; (print "s1 and s2")
; (print s1)
; (print s2)
; (setq flag1000(1+ flag1000))
(append s1 s2 )
)
(defun add-to-stream (e s )
; (print " two additions to stream")
; (print e)
; (setq flag1000 (1+ flag1000))
; (print s)
(cons e s)
)
(defun add-to-stream1 (e s )
; (print " two additions to stream from filter assertions")
; (print e)
; (setq flag1000 (1+ flag1000))
; (print s)
(cons e s)
)
(defun first-of-stream (s )
(car s)
)
(defun rest-of-stream ( s )
(cdr s )
)
(defun empty-stream-p ( s )
(null s)
)
(defun make-empty-stream ()
nil
)
(defun filter-assertions (pattern initial-a-list)
; (print "called filter-assertions")
; (print "initial-a-list")
; (print initial-a-list)
(setq testflag 4 assertions assertions flag10 1)
(setq dummy-assertions assertions)
(setq a-list-stream (make-empty-stream))
(while (< testflag 5)
(cond ((equal assertions nil )(setq testflag 5))
( T (setq flag10 (1+ flag10)))
)
(cond ((= testflag 4)
(setq new-a-list (match pattern (car assertions) initial-a-list))
)
)
(cond ((= testflag 4)
(cond (new-a-list (setq a-list-stream
(add-to-stream1 new-a-list a-list-stream)
)
)
)
)
)
(setq assertions (cdr assertions))
)
; (print "new-a-list and a-list-stream in filter assertions")
; (print new-a-list)
; (terpri)
; (print a-list-stream)
(setq assertions dummy-assertions)
(setq a-list-stream a-list-stream)
)
(defun filter-a-list-stream (patterns a-list-stream) ;s add to pattern
; (print "pattern in filter-a-list-stream")
; (print patterns)
; (print "a-list-stream in falt")
; (print a-list-stream)
; (print "inset line")
; (print "flag1000")
; (print flag1000)
(setq a1000 (first-of-stream a-list-stream))
(setq a1001 (rest-of-stream a-list-stream))
; (print "first")
; (print a1000)
; (print "rest")
; (print a1001)
(cond ((empty-stream-p a-list-stream)(make-empty-stream))
( T (combine-streams
(filter-assertions patterns a1000) ;(first-of-stream a-list-stream
(filter-a-list-stream patterns a1001) ; (rest-of-stream a-list-str
)
)
)
)
(defun ctp (patterns a-list-stream)
; (setq flag (+ flag 1))
; (print "flag")
; (print flag)
; (print "patterns in ctp ")
; (print patterns)
; (print "a-list-stream in ctp")
; (print a-list-stream)
(cond (( null patterns ) a-list-stream)
( T (dummy patterns a-list-stream))
)
)
(defun dummy (patterns a-list-stream)
; (print "called dummy")
; (print "car patterns")
; (print (car patterns))
; (print "cdr patterns")
; (print (cdr patterns))
(filter-a-list-stream (car patterns)(ctp (cdr patterns)
a-list-stream )
)
)
(defun body_3 ()
(setq new-a-list (match pattern (car assertions) initial-a-list))
(cond (new-a-list (setq a-list-stream
(add-to-stream new-a-list a-list-stream)
)
)
)
)
(defun body_2 (action-stream)
(setq action (replace-variables (car actions) a-list))
; (print "here")
; (print"action")
(setq flagbody_2 0)
; (print action)
(cond ((not (null action))(return_4 action))
)
(cond ((= flagbody_2 1)(setq action-stream (return_3 action-stream)))
)
; (print "action stream after return 3 in body 2")
; (print action-stream)
(setq action-stream action-stream)
)
(defun return_4 (action)
(remember action )
; (print "here at return_4")
(setq flagbody_2 1)
)
(defun return_3 (action-stream)
(print)
(setq a1007 'RULE__ )
(prin1 a1007 )
(prin1 rule-name)
(setq a1008 '_SAYS_)
(prin1 a1008)
(cond ((null (car action))nil) ;(prin1 (car action))
(T (print_2 action)
)
)
(print)
; (print "here at return_3")
(setq action-stream (add-to-stream action action-stream))
; (print "action-stream at return_3")
; (print action-stream)
(setq action-stream action-stream)
)
(defun print_2 (ah_list)
(setq a1013 '_)
(cond ((null (car ah_list))nil)
( T (prin1 (car ah_list)))
)
(cond ((null (car ah_list))nil)
( T (prin1 a1013))
)
(cond ((null (car ah_list))nil)
( T (print_2 (cdr ah_list))
)
)
)
(defun spread-through-actions (rule-name actions a-list)
; (print "start spread through actions")
; (print " rule-name")
; (print rule-name)
; (print "actions")
; (print actions)
; (print "a-list")
; (print a-list)
(setq testflag 2 actions actions action-stream (make-empty-stream))
(while ( < testflag 3)
; (print "testflag")
; (print testflag)
(cond ((null actions )(return_1 ))
)
(cond ((= testflag 2 )(setq action-stream (body_2 action-stream)))
)
(setq actions (cdr actions))
; (print" at actions")
; (print actions)
)
; (print "end at action stream")
; (print action-stream)
; (print "end")
(setq action-stream action-stream)
)
(defun return_1 ()
; (print " at return_1")
(setq testflag 3)
)
(defun replace-variables (s a-list )
; (print "at replace-variables")
; (print "s")
; (print s)
; (print "a-list")
; (print a-list)
(cond ((atom s ) s)
((equal (car s) '<)
(cadr (assoc (pattern-variable s ) a-list ))
)
(T (cons (replace-variables (car s ) a-list )
(replace-variables (cdr s) a-list )
)
)
)
)
(defun feed-to-actions(rule-name actions a-list-stream)
; (print "start feed to actions")
; (print "rule-name")
; (print rule-name)
; (print "actions")
; (print "a-list-stream")
(setq a1002 (first-of-stream a-list-stream))
(setq a1003 (rest-of-stream a-list-stream))
; (print a-list-stream)
; (print "first")
; (print a1002)
; (print "rest")
; (print a1003)
(cond ((empty-stream-p a-list-stream) (make-empty-stream))
(T (combine-streams
(spread-through-actions rule-name
actions
a1002;(first-of-stream a-list-stream)
)
(feed-to-actions rule-name
actions
a1003 ; (rest-of-stream a-list-stream)
)
)
)
)
)
(defun use-rule (rule)
(setq rule-name (cadr rule))
; (print "rule:")
; (print rule)
; (print "rule-name:" )
; (print rule-name)
(setq ifs (reverse (cdr (caddr rule ))))
; (print "ifs and thens")
; (print ifs)
(setq thens (cdr (cadddr rule)))
; (print thens)
(setq a-list-stream (ctp
ifs
(add-to-stream nil (make-empty-stream))
)
)
; (print "a-list-stream after cascade through patterns")
; (print a-list-stream)
; (print "end")
(setq action-stream (feed-to-actions rule-name thens a-list-stream))
; (print "action-stream")
; (print action-stream)
(not (empty-stream-p action-stream))
)
(defun forward-chain ()
(setq flagtest 0 )
(setq rules-to-try rules)
; (print "rules")
; (print rules-to-try)
(setq progress-made nil)
(setq progress-made1 1)
(while (< flagtest 1)
(cond ((null rules-to-try )(return progress-made))
( T (body_1))
)
; (cond ((= flagtest 0)(body_1))
; )
(setq rules-to-try (cdr rules-to-try))
; (print "rules-to-try")
; (print rules-to-try)
(print "assertions")
(print assertions)
)
(setq progress-made progress-made)
)
(defun return (progress-made)
(setq flagtest 1)
(setq progress-made progress-made)
)
(defun body_1 ()
; (print "progress-made")
; (print progress-made)
; (print "called body-one")
; (print )
(cond ((use-rule (car rules-to-try ))
; (setq rules-to-try rules)
(setq progress-made T)
)
)
)
(defun initialize-rules ()
(setq assertions
'((belmont is a suburb of newcastle)
(newcastle is within HDWB region)
(sydney is within SWB region)
)
)
(setq rules '((rule identify1
(IF ((> town) is a suburb of (> city))
((< city) is within (> region) region))
(THEN ((< town) uses (< region) rules))
)
(rule identify2
(IF ((> town) uses HDWB rules))
(THEN (pipe type is VC)
(pipe sizes are 150 250 300 375))
)
(rule identify3
(IF ((> town) uses SWB rules))
(THEN (pipe type is AC)
(pipe sizes are 150 250 300 375 450))
)
)
)
)
; COMMAND FILE This is the highest level : all others called
(defun C:AI ()
(firststage ) ; start at the top of file for level 1
)
it took six months from Winston and Horne to AutoLISP - I wonder how long in Fortran -- I am assuming six more months
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Link.exe on Visual Studio 2015 causes the linker issue when /WHOLEARCHIVE switch is used. To overcome this issue, install the hotfix to your Visual C++ compiler available at https://support.microsoft.com/en-us/help/4020481/fix-link-exe-crashes-with-a-fatal-lnk1000-error-when-you-use-wholearch
-----------------------------------------------------------------------------------------------------------------
How to compile tensorflow onto Windows -- can someone explain why people like Python so much it is a terrible language to learn and use - filled with syntactic sugar
Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page