cobol, Geriatric farts WAS: The list of INVOKEs

1. List of "CALLs" vs List of INVOKEs

Starting a new thread - based on an  older one.

The comparison of a COBOL compiler vendor providing a "list of INVOKEs" when 
compared to a "Lit of CALLs" actually raises and interesting (to me) topic.

For Micro Focus, for example, they do provide a list of
 - CBL_
 - PC_
 - hex-literal
subroutines that they provide.  In almost all (well at least many) of these 
cases, you can "get the same effect" by using some System API or a call to 
"system" with specific parameters.

In some (not all) ways, this is similar to the way that IBM provides LE callable 
services.  Again, many of these services CAN be achieved by "system" defined 
(and named) services.

Therefore, I certainly CAN imagine a COBOL programmer thinking that the COBOL 
vendor (rather than the "Object owner") might provide "my-COBOL-specific" 
methods (or classes) to access facilities (such as Microsoft Excel).  Why they 
might do that I can't imagine (and as I don't know of any vendor that does it, I 
don't think there are good reasons for it.)  However, as someone who does 
understand (I think) Pete's and Frederico's (and other's) posts, I did think 
that I might bring this up as a POSSIBLE area of confusion.

The bottom-line being that (at least for Microsoft "products"), Microsoft, not 
Micro Focus (or Fujitsu or other COBOL vendors) does provide "adequate" classes 
and methods (and properties) and it is these that should be looked at by the 
COBOL programmer.  This is UNLIKE certain types of "system" CALLs/API's where 
the COBOL vendors have provided their own interfaces to the underlying system 
service.

-- 
Bill Klein
 wmklein <at> ix.netcom.com 

2. Cross referencing objects: Am I invoking UB?

3. The list of INVOKEs

4. Having a brain fart with entry controls ...

5. FART Performance

I'm looking for some advice on mathematical optimization in CL. I have
implemented a Fuzzy ART network, and I wonder how I might
significantly improve the performance.

After trying some simple differential benchmarks on simple constructs,
I tried implementing it without CLOS, using a struct instead of class
and functions instead of methods. After benchmarking the alternate
implementation (and keeping in mind that small differences will
snowball into big differences as the size of the network grows), I
didn't see enough difference to justify the sacrifices. (Due to the
input randomization, the resulting networks had slightly different
sizes, but they were close enough. I'll have to devise a static set of
inputs to truly compare apples to apples.)

Because the application requires chaining FARTs together, to build
multi-level networks, such as Fusion ARTMAPs, I'll require a
structured architecture.

I tried profiling with SBCL's profiling utilities, but as I don't have
much experience profiling in CL, I didn't quite know how to interpret
the reports.

>>>>>>>>>>

(defclass fart ()
  ((inputs
    :initarg :inputs :accessor inputs :type simple-vector
    :documentation "the vector of inputs (I)")
   (outputs
    :initarg :outputs :accessor outputs :initform nil
    :documentation "the vector of outputs (Y)")
   (weights
    :initarg :weights :accessor weights :initform nil
    :documentation "the two-dimensional vector of weights (W)")
   (vigilance
    :initarg :vigilance :accessor vigilance :initform 0.0 :type single-
float
    :documentation "the vigilance parameter (phi)")
   (alpha
    :initarg :alpha :accessor alpha :initform 0.0 :type single-float
    :documentation "the alpha parameter")
   (beta
    :initarg :beta :accessor beta :initform 0.0 :type single-float
    :documentation "the beta parameter")
   (winner
    :initarg :winner :accessor winner :initform 0 :type single-float
    :documentation "the winning category")
   (size-delta
    :initarg :size-delta :accessor size-delta :initform 8 :type
integer
    :documentation "the amount by which vector allocations will grow")
   (complement-coding
    :initarg :complement-coding :accessor complement-coding :initform
t
    :documentation "whether the fuzzy-art complement-codes its
input")))

(defmethod initialize-instance :after ((instance fart) &key)
  (with-accessors ((outputs outputs) (weights weights) (winner winner)
		   (size-delta size-delta)) instance
    (unless (and (slot-boundp instance 'outputs) outputs)
      (setf outputs (make-array size-delta :element-type 'single-
float :fill-pointer 0)))
    (unless (and (slot-boundp instance 'weights) weights )
      (setf weights (make-array size-delta :initial-element nil :fill-
pointer 0)))
    (unless (and (slot-boundp instance 'winner) (>= winner 0))
      (setf winner 0)))
  instance)

(defgeneric feed-inputs (element value))

(defmethod feed-inputs ((fart fart) (value array))
  "Set the current input vector for training. With complement-coding
disabled,
this method merely sets inputs to value, so altering the shared array
object would
lead to undefined behavior. With complement-coding enabled, it sets
inputs to
a complement-coded copy of value. Related egghead methods do not alter
the value array."
  (if (complement-coding fart)
      (let* ((length (length value))
	     (array (make-array (* 2 (length value)) :element-type 'single-
float)))
	(loop for i from 0 below length
	      for ii across value
	      do (setf (aref array i) ii (aref array (+ i length)) (- 1 ii))
	      finally (return (setf (inputs fart) array))))
      (setf (inputs fart) value)))

(defgeneric grow (element))

(defmethod grow ((fart fart))
  "The outputs vector (y) and the weights vector (w) grow together.
This method will
increment the fill-pointer of each vector, increase the vector
allocations if necessary,
set the winner to the new category and return T, indicating that the
winning category is
uncommitted."
  (with-accessors ((outputs outputs) (weights weights) (winner
winner)
		   (size-delta size-delta)) fart
    (let ((category-count (fill-pointer outputs)))
      (when (eq (array-dimension outputs 0) category-count)
	(adjust-array outputs (+ category-count size-delta))
	(adjust-array weights (+ category-count size-delta) :initial-element
nil))
      (incf (fill-pointer outputs))
      (incf (fill-pointer weights))))
  t)

(defgeneric fire (element #|activator signal context|#))

(defmethod fire ((fart fart) #|activator signal context|#)
  (setf (winner fart) -1)
  (if (eq 0 (fill-pointer (outputs fart)))
      (grow fart)
      (let* ((max-y most-negative-single-float)
	     (inputs (inputs fart)) (outputs (outputs fart)) (weights
(weights fart))
	     (alpha (alpha fart)) (vigilance (vigilance fart)) (winner
(winner fart))
	     (sum-inputs (loop for ii across inputs sum ii into sum finally
(return sum))))
	;; TODO: With complement-coding, sum-inputs will be constant across
input vectors
	;; of the same size--i.e., half of the node count of the complement-
coded input vector.
	(loop for j from 0 below (length outputs)
	      for wj across weights
	      do (multiple-value-bind (sum-weights sum-iw)
		     (loop for wji across wj
			   for ii across inputs
			   sum wji into sum-weights
			   sum (min wji ii) into sum-iw
			   finally (return (values sum-weights sum-iw)))
		   ;; FIX: As it is, fire activates all of the outputs, when it
should only
		   ;; activate the winner. Use a vector pre-y for pre-activation
signals,
		   ;; zero the outputs and activate only the winner.
		   (setf (aref outputs j) (/ sum-iw (+ alpha sum-weights)))
		   (if (and (>= sum-iw (* vigilance sum-inputs))
			    (< max-y (aref outputs j)))
		       (setf winner j max-y (aref outputs j)))))
	(setf (winner fart) winner)
	(if (eq winner -1)
	    (grow fart)
	    nil))))

(defgeneric learn (element #|specialty signal context|#))

(defmethod learn ((fart fart) #|specialty signal context|#)
  (with-accessors ((inputs inputs) (outputs outputs) (weights weights)
		   (beta beta) (winner  winner)) fart
    (if (eq -1 winner)
	;; fast learning
	(progn
	  (setf winner (1- (fill-pointer outputs)))
	  (setf (aref weights winner) (copy-seq inputs))
	  (setf (aref outputs winner) 1.0))
	;; slow recoding
	(let ((wj (aref weights winner))) ; winner must be a valid index into
weights
	  (loop for i from 0 below (length inputs)
		for wji across wj
		for ii across inputs
		do (setf (aref wj i) (+ (* beta (min ii wji)) (* (- 1 beta) wji)))
		finally (return nil))))))

(defgeneric train-current (element))

(defmethod train-current ((fart fart))
  (fire fart #|nil nil nil|#)
  (learn fart #|nil nil nil|#))

(defparameter *fart* (make-instance 'fart :vigilance 0.89 :alpha
0.000001 :beta .1 :size-delta 2048))
(defparameter *inputs* (make-array 4 ))
(proclaim '(simple-vector *inputs*))

(defun bang ()
  (loop for i from 0 below (length *inputs*)
	do (setf (svref *inputs* i) (coerce (/ (random 100) 100) 'single-
float)))
  (feed-inputs *fart* *inputs*)
  (train-current *fart*)
  (winner *fart*))

>>>>>>>>>>

; On an AMD Athlon(tm) 64 X2 Dual Core Processor 4200+, with 2GB RAM,
; a linux-2.6.17, 64-bit Gentoo system and SBCL 1.0.1, I have the
following:
CL-USER> (time (dotimes (n 10000) (bang)))
Evaluation took:
  7.193 seconds of real time
  7.192449 seconds of user run time
  0.0 seconds of system run time
  0 calls to %EVAL
  0 page faults and
  2,467,552 bytes consed.
NIL
CL-USER> (length (outputs *fart*))
560
; Of course, as the network grows, the runtime increases.
CL-USER> (time (dotimes (n 10000) (bang)))
Evaluation took:
  13.337 seconds of real time
  13.336833 seconds of user run time
  0.0 seconds of system run time
  0 calls to %EVAL
  0 page faults and
  2,446,848 bytes consed.
NIL
CL-USER> (length (outputs *fart*))
829
CL-USER>
; Build a network up to a few thousand nodes, and you might as well go
find other things to do while it chews on it.
>>>>>>>>>>

I tried a couple of things, such as proclaiming data types of slots,
arrays and specific variables, making arrays simple-vectors where
possible, etc., but I wasn't seeing any dramatic gains. I'd wager that
the bottleneck is the math--correct me if I'm wrong. Due mostly to my
inexperience in CL optimizations, I imagine that there must be a few
things that will result in marked performance improvements. Does
anyone have some pointers on where to start?

Thanks in advance,
Jack

6. I am getting following error when I am building my C program

7. A trivial problem with Tk, I am sure I am not doing it the right way

Hi All

I am novice in Tk , so I have goofed up somewhere in my code ...Need
help

Heres my partial code snippet

# I define a global variable

set udrPath /udr

# and then I use it as textvariable for my entry widget
entry .bfmc.ud -text "/udr" -textvariable udrPath

#next to the entry widget, i have a button
button .bfmc.btud -text "Set" -command { MIBUpdate 0 $udrPath }

#So my idea is to trigger MIBUpdate procedure with the value of udrPath
whenever I click the button

#MIB Update is defined as

proc MIBUpdate { type value } {

    global udp testStat udrPath


    if { $testStat == "Stop" } {

	puts $udp $type$value
    }

    if { $type == 0 } {

	set udrPath $value

    }

}

SO basically I enter a text in entry widget and it get set in the
udrPath variable
then when I click the button the MIBUpdate is called and the udrPath
value is sent to a udp socket inside the procedure.

This works fine in normal scenarios but there is a problem .as follows

if I enter the first time
/udr as the value inside entry it works well

but next time if i enter, say
/ab , then the value at remote udp socket is /abr instead of /ab , so
/ab overwrites /ud of /udr and becomes /abr

i.e the new value overwrites the previous value instead of scrapping it
totally.

I am sure there is a workaround but i am just not able to figure it
out.

Any help will be appreciated

thanks
in advance

8. Lists within Lists or Nested Linked Lists...