Commit f050aa02 authored by Bonte Bruno's avatar Bonte Bruno
Browse files

Add features for using R to couple models

	* Cormas: A dedicated identifier function in Entity Class (in Add-ons)
	* Cormas: A change in setAttributeofClassvalue function (in Add-ons) to set or to get values of attribute of all instances of a class
	* Cormas: A spectial class to do this (DataTansfR in Add-ons)
	* R: functions to call theses cormas functions in cormas-func.R
parent f38f568c
No related merge requests found
Showing with 201 additions and 4 deletions
+201 -4
<?xml version="1.0"?>
<st-source>
<time-stamp>From VisualWorks® NonCommercial, 7.6 of lundi 3 mars 2008 on jeudi 19 octobre 2017 at 3:27:30</time-stamp>
<time-stamp>From VisualWorks® NonCommercial, 7.6 of lundi 3 mars 2008 on mardi 15 octobre 2019 at 6:45:34</time-stamp>
<methods>
......@@ -9,14 +9,24 @@
<body package="Cormas" selector="setAttribute:ofClass:value:">setAttribute: attName ofClass: aClassName value: aValue
| notThere aCAV aClass |
| notThere aCAV aClass transferer|
"aClassName = symbol du nom de la class"
"self setAttribute: 'infectiousPeriod' ofClass: Host value: 40"
&lt;operationName: #SetAttributeOfClassValue &gt;
&lt;addParameter: #attName type: #String &gt;
&lt;addParameter: #className type: #ByteString &gt;
&lt;addParameter: #value type: #Float &gt;
&lt;result: #String &gt;
&lt;result: #String &gt;
"In data transfer mode, all data is sent in the attName argument since it is a string. aValue argument is not used"
aClassName asSymbol = #DataTransfRSet ifTrue: [
"exemple: self setAttribute: 'Efarmer;age;1,2,3,4,5,6,7,8,9,10;20,20,20,20,20,50,50,50,50,50' ofClass: 'DataTransfRSet' value: 0"
transferer := DataTransfR newData: attName cormas: myCormas.
transferer setData.
^'done'].
aClassName asSymbol = #DataTransfRGet ifTrue: [
"example: self setAttribute: 'Efarmer;age; ; ' ofClass: 'DataTransfRGet' value: 0"
transferer := DataTransfR newData: attName cormas: myCormas.
^transferer getData].
notThere := true.
aClass:= myCormas cormasModel classFromSymbol: aClassName .
(DefaultAttributesSetter attributsFromClass: aClass)
......@@ -25,7 +35,6 @@
aCAV := ClassAttributeValue newClass: aClass attribute: attName value:
aValue.
self myCormas cormasModel defaultAttributesSetter applyNewValue: aCAV.
myCormas cormasModel recievedNotification.
^'done'</body>
</methods>
......
<?xml version="1.0"?>
<st-source>
<time-stamp>From VisualWorks® NonCommercial, 7.6 of lundi 3 mars 2008 on mardi 15 octobre 2019 at 6:46:00</time-stamp>
<class>
<name>DataTransfR</name>
<environment>CormasNS.Kernel</environment>
<super>Core.Object</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>myCormas entityType attribute ids values </inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category></category>
<attributes>
<package>Cormas</package>
</attributes>
</class>
<!-- - - - - - - - - - - - - - - - - - - -->
<methods>
<class-id>CormasNS.Kernel.DataTransfR class</class-id> <category>instance creation</category>
<body package="Cormas" selector="new">new
"Answer a newly created and initialized instance."
^super new initialize</body>
<body package="Cormas" selector="newData:cormas:">newData: classAttIdsValues cormas: aCormasInstance
"Answer a newly created and initialized instance."
| newBe idsValues data|
newBe:= self new.
newBe myCormas: aCormasInstance.
data := classAttIdsValues asArrayOfSubstringsSeparatedBy: $;.
newBe entityType: data first.
newBe attribute: (data at: 2).
idsValues:= (data at: 3) asArrayOfSubstringsSeparatedBy: $,.
idsValues size &gt; 0 ifTrue: [
newBe ids: (idsValues asOrderedCollection collect: [: string | string asInteger]).
newBe values: ( ( (data at: 4) asArrayOfSubstringsSeparatedBy: $,) asOrderedCollection collect: [: string | string asNumber asFloat]).
].
^newBe</body>
</methods>
<!-- - - - - - - - - - - - - - - - - - - -->
<methods>
<class-id>CormasNS.Kernel.DataTransfR</class-id> <category>initialize-release</category>
<body package="Cormas" selector="initialize">initialize
"Initialize a newly created instance. This method must answer the receiver."
" *** Replace this comment with the appropriate initialization code *** "
^self</body>
</methods>
<methods>
<class-id>CormasNS.Kernel.DataTransfR</class-id> <category>accessing</category>
<body package="Cormas" selector="attribute">attribute
^attribute</body>
<body package="Cormas" selector="attribute:">attribute: anObject
attribute := anObject</body>
<body package="Cormas" selector="entityType">entityType
^entityType</body>
<body package="Cormas" selector="entityType:">entityType: anObject
entityType := anObject</body>
<body package="Cormas" selector="ids">ids
^ids</body>
<body package="Cormas" selector="ids:">ids: anObject
ids := anObject</body>
<body package="Cormas" selector="myCormas">myCormas
^myCormas</body>
<body package="Cormas" selector="myCormas:">myCormas: anObject
myCormas := anObject</body>
<body package="Cormas" selector="values">values
^values</body>
<body package="Cormas" selector="values:">values: anObject
values := anObject</body>
</methods>
<methods>
<class-id>CormasNS.Kernel.DataTransfR</class-id> <category>transfer</category>
<body package="Cormas" selector="getData">getData
| sortedEntities |
sortedEntities := (self myCormas cormasModel
perform: ('the' , self entityType , 's') asSymbol) asOrderedCollection
asSortedCollection: [:e1 :e2 | e1 idRTransfer &lt; e2 idRTransfer].
self ids: ''.
self values: ''.
sortedEntities
do:
[:entity |
self ids: self ids, entity idRTransfer asString , ','.
self values: self values, (entity perform: self attribute asSymbol) asString, ','].
^self ids,';', self values</body>
<body package="Cormas" selector="setData">setData
| sortedEntities nb args |
sortedEntities := (self myCormas cormasModel
perform: ('the' , self entityType , 's') asSymbol) asOrderedCollection
asSortedCollection: [:e1 :e2 | e1 idRTransfer &lt; e2 idRTransfer ].
nb := 1.
sortedEntities
do:
[:entity |
(entity idRTransfer = (self ids at: nb))
ifTrue:
[
args := Array new: 1.
args at: 1 put: (self values at: nb).
entity
perform: (self attribute , ':') asSymbol
withArguments: args]
ifFalse: [self halt].
nb := nb + 1]</body>
</methods>
</st-source>
<?xml version="1.0"?>
<st-source>
<time-stamp>From VisualWorks® NonCommercial, 7.6 of lundi 3 mars 2008 on mardi 15 octobre 2019 at 6:46:21</time-stamp>
<methods>
<class-id>CormasNS.Kernel.Entity</class-id> <category>rTransfer</category>
<body package="Cormas" selector="idRTransfer">idRTransfer
"A method to identify entities for transfer with R (DataTransfR class uses the name of the entity class and this id to reference instances)"
^self id</body>
</methods>
</st-source>
cormas-func.R 100644 → 100755
......@@ -132,5 +132,42 @@ return(askCormas("SetStringAttributeOfClassValue",
argValues=c(attributeName, className, value)))
}
setAttributesOfEntities <- function(attributeName, className, entitiesIds, values){
#This method uses a special feature of the method CormasWS>>setAttribute:ofClass:value:
#designed to set values of attribute "attributeName" of all entities of class "className"
answer <- askCormas("SetAttributeOfClassValue",
argNames = c("attName", "className", "value"),
argValues = c(paste(className,
attributeName,
paste(as.character(entitiesIds),collapse = ","),
paste(values,collapse = ","),
sep = ";"),
"DataTransfRSet",
0))[[2]]
stringRes <- xml_text(xml_find_all(content(answer),xpath=".//ns:result"))
return(stringRes)
}
getAttributesOfEntities <- function(attributeName, className, num = T){
#This method uses a special feature of the method CormasWS>>setAttribute:ofClass:value:
#designed to get values of attribute "attributeName" of all entities of class "className"
answer <- askCormas("SetAttributeOfClassValue",
argNames = c("attName", "className", "value"),
argValues = c(paste(className, attributeName, " ", " ", sep=";"),
"DataTransfRGet",
0))[[2]]
stringRes <- xml_text(xml_find_all(content(answer),xpath=".//ns:result"))
idsValues <- strsplit(stringRes, split = ";")[[1]]
res <- data.frame(id = unlist(strsplit(idsValues[1], split = ",")),
value = unlist(strsplit(idsValues[2], split = ",")))
if (num) {res$value <- as.numeric(as.character(res$value))}
colnames(res)<- c("id", attributeName)
return(res)
}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment