VAR R-funktioilla

[viesti Survo-keskustelupalstalla (2001-2013)]

Heippa,

Olen yrittänyt vähän taiteilla R:n ja Survon kanssa,
josko R:n muuttujamuunnoksia voisi käyttää
ikään kuin Survon VAR-operaationa. Tässäpä hieman demoa:


DATA _KOE1
HOBBY   Y
auto    1
koira;kissa  1
juoksu  1
kissa   1
kirjat  1
survo;auto  1
sienet  1
R;survo   1
srvo    1
metsästys 1
monta_asiaa:_R,musa,kissat 1
monta_asiaa:_survo;musa;kissat 1


FILE COPY _KOE1 TO NEW KOE
FILE SHOW KOE

1. Säännölliset lausekkeet (ks. funktiot viestin lopussa)
survo (sallitaan kirjoitusvirheitä)
/R_VAR SURVO=f.agrep("survo",KOE$HOBBY) TO KOE

survo tai auto  (virheitä ei sallita)
/R_VAR SURVOCAR=f.grep("auto|survo",KOE$HOBBY) TO KOE

2. Muita
Osite indeksi:
/R_VAR PARTS=gl(3,4) TO KOE / KOE$Y (huom.)

Ja tältä näyttävät tulokset
FILE LOAD KOE
DATA KOE*,A,B,C
 HOBBY                          Y      SURVO    SURVOCAR       PARTS
 auto                           1      0.000       1.000       1.000
 koira;kissa                    1      0.000       0.000       1.000
 juoksu                         1      0.000       0.000       1.000
 kissa                          1      0.000       0.000       1.000
 kirjat                         1      0.000       0.000       2.000
 survo;auto                     1      1.000       1.000       2.000
 sienet                         1      0.000       0.000       2.000
 R;survo                        1      1.000       1.000       2.000
 srvo                           1      1.000       0.000       3.000
 metsästys                      1      0.000       0.000       3.000
 monta_asiaa:_R                 musa   0.000       0.000       3.000
 monta_asiaa:_survo;musa;kissat 1      1.000       1.000       3.000


Tämä toimii vain silloin kun uusi muuttuja on numeerinen,
esim. päivämäärä -merkkijono ei onnistu:

/R_VAR DATE=dates("1.1.06") TO KOE / KOE$HOBBY LIB=library(chron)

(LIB tarkoittaa, että muunnosta varten tarvitaan chron paketti)
Sukrossa uusi muuttuja on siirretty
aineistoon VAR + INDATA:aa hyödyntäen. Tähän pitäisi keksiä jokin
parempi tapa ellei merkkijonoa voida sallia.
Hankaluutta aiheuttaa joka tapauksessa se, että
merkkijonon pituus pitäisi kai tietää etukäteen. Jos tämän voisi
välttää, niin esim. MATCH=# olisi luonteva.

Tässä versiossa on mahdollista kirjoittaa R-funktio ainoastaan yhdelle
riville, yleistäminen useammalle riville vaatii pikkaisen erilaisen
toteutuksen kuin {save line Wline}, homma ilm. tekstitiedostona.
Kaikenlaista muutakin pitänee huomioida,

t. Petri

Lopussa kaksi tekemääni R-funktiota f.agrep ja f.grep,
jotka pitää tallettaa SURVO.R tiedostoon

Tässä sukron listaus:

*TUTSAVE R_VAR
/
/  /R_VAR <NEWVAR>=<R-function of <data>$<OLDVAR>'s> TO <data> /
/
/ VAR transformation by R functions
/
*{tempo -1}{init}
- if W1 '=' RETURN then goto E2
/
/ def Wvar=W10 Wrfunc=W3 Wfile=W5 Wargs=W7 Wtmp=W9
/ def Wdatapath=W11 Wtempdisk=W12  Wline=W13
/ def Wx1=W21 Wx2=W22 Wx3=W23 Wx4=W24 Wdata2=W24
/ def Wdatapath2=W31 Wsystempath=W32 Wversion=W33
/
*{init}{tempo 0}{line start}{save line Wline}
*{save stack}{W1=VAR}{call SUR-SAVE}{del stack}{load stack}
/
/ if Wfile '=' {} then goto ERR1
/
*{jump 1,1,1,1}SCRATCH {act}{line start}
/
*{form}/R_VAR RETURN / to current application
/
*{R}
*REDIM 2000,200{act}{R}
*RESIZE 54,90{act}{R}
*{ref set 1}{R}
*{print Wline}
*{ref jump 1}{line start}
*REPLACE "="," ",C{act}{line start}{erase}
*REPLACE "$"," $ ",C{act}{line start}{erase}
*REPLACE "(","( ",C{act}{line start}{erase}
*REPLACE ")"," )",C{act}{line start}{erase}
*REPLACE ","," , ",C{act}{line start}{erase}
*REPLACE "   "," ",C / LINES=CUR+1,END{act}{line start}{erase}
*REPLACE "  "," ",C / LINES=CUR+1,END{act}{line start}{erase}
/
*{R}{next word}{save word Wvar}{line start}{u2}{ins line}{ref set 1}
*FIND ") TO "{act}{R}{next word}{next word}{save word Wfile}{ref jump 1}
*{line start}
*{ins line}{print Wfile}{sp}{print Wvar} / data{R}
/{goto END}
/
*{ins line}{line start}{ref set 2}{u}{line start}{ref set 1}
/ VARS lista
+ GetVars: {ref jump 1}{line start}{erase}
*FIND "{print Wfile} "{act}{R}{del}{next word}{save word Wtmp}
- if Wtmp '=' {sp} then goto EndGvar
- if Wtmp '<>' $ then goto GetVars
*{next word}{save word Wx1}
/ if Wx1 '=' {} then goto EndGvar
*{ref jump 2}{line end}{print Wx1},
*{goto GetVars}
+ EndGvar: {R}{line end}{l}{del}{line start}{save line Wx1}{R}
/
/{jump end+1,end+2,1}{print Wx1}
/{goto END}
*{save datapath Wdatapath}{save tempdisk Wtempdisk}
*{print Wdatapath}{R}
*{R}
*..................{R}
*CHECK {print Wfile}.SVO{act}{r}{save char W2}
- if W2 '<>' O then goto ERR2
*{R}
/{goto END}
*.............{R}
*VARS={print Wx1} / {print Wline}{R}
/{goto END}
*>DEL {print Wtempdisk}_tmp1.txt{act}{R}
*FILE LOAD {print Wfile} TO {print Wtempdisk}_tmp1.txt /{sp}
*DELIMITER=TAB NAMES=8{act}{R}
*...............{R}
/{goto END}
*CD {print Wtempdisk}{act}{R}
*{ins line}
*{print Wline}
*{u}{line start}{erase}
*FIND "="{act}{R}{del}{save line Wline}{line start}{erase}
*{print Wline}
*{u}{line start}{erase}
*FIND " TO "{act}{R}{erase}{line start}{save line Wline}{R}
*...............{R}
/{goto END}
*{ref set 1}{R}
*{print Wfile} <- read.table("_tmp1.txt", header=T, sep="\t"){R}
*#{R}
*{print Wfile}${print Wvar} <- {print Wline}{R}
*tmp1 <- {print Wfile}[, "{print Wvar}"]{R}
*# names(tmp1) <- "{print Wvar}"{R}
*write.table(tmp1, file="_{print Wvar}.txt", col.names=FALSE  ,{R}
*quote=F, sep="\t", row.names=FALSE){R}
*#{R}
*{ref jump 1}
*SAVEP CUR+1,END,_r.r{act}{jump end+1,end+1,1}{R}
/
*{save datapath Wdatapath2}{save systempath Wsystempath}
/
*PUTENV R_PROFILE={write Wsystempath}SYS\SURVO.R{act}{R}
/
*{print Wdatapath2}{R}
*{line start}{erase}{pre}F{ref}
/{goto END}
/
*{save system R_path W6}>{print W6}\bin\RTERM.EXE
* HOME={write Wdatapath2}
* &{R}
* --save -q
/ --no-restore --no-save -q
/{goto END}
+ A:  <_r.r >R.LIS 2>&1{ref}{ref}{act}
/{del line}{del line}
/{del line}
*{R}
*{R}
*.............{R}
*DELIMITER=TAB FIRST=1 LAST=99999999999 / (max survon sallima){R}
*FILE SAVE _{print Wvar}.txt TO NEW {print Wdatapath}__TMP{act}{R}
*>DEL *.RData{act}{R}
/{goto END}
*CD {print Wdatapath}{act}{R}
*..............{R}
*FILE EXPAND {print Wfile},1,20{act}{R}
/Tässä ongelma: jos vektori on merkkijono, niin homma ei onnistu
*INDATA=__TMP{R}
*VAR {print Wvar}=D1:X1 TO {print Wfile}{act}{R}
/
/{goto END}
*{W1=VAR}{call SUR-RESTORE}{goto END}
/
+ ERR1: {message}   Usage: /R_VAR Y=f(DATA$X) TO DATA!@
*{goto E1}
+ ERR2: {message}        Data file not found!@{goto E1}
/
+ E1:
- on key
-   key _: continue
-   wait 300
+ E2: {message}@{W1=VAR}{call SUR-RESTORE}
+ END: {R}{end}
*.....................
*
SURVO.R -tiedostoon


## Grep (indicator variable) ##
f.grep<-function(string,x, ignore.case = TRUE,
            extended = TRUE, perl = FALSE,
    value = FALSE, fixed = FALSE, useBytes = FALSE)
  {
    lv.0<-as.character(x)
    lv.1<- rep(0,length(lv.0))
    lv.1[grep(string,lv.0, ignore.case = ignore.case,
              extended = extended, perl = perl,
    value = value, fixed = fixed, useBytes = useBytes)]<-1
    lv.1
}
##


## Agrep ##
f.agrep<-function(string,x, ignore.case = TRUE, value = FALSE,
                max.distance = 0.1)
  {
    lv.0<-as.character(x)
    lv.1<- rep(0,length(lv.0))
    lv.1[agrep(string,lv.0, ignore.case = ignore.case,
       value = value, max.distance = max.distance)]<-
    lv.1
}
##


.......................

• Re: VAR R-funktioilla (Kimmo Vehkalahti 3.3.2006 20:04)

Luettelo keskustelunaiheista

Survo-keskustelupalstan (2001-2013) viestit arkistoitiin aika ajoin sukrolla, joka automaattisesti rakensi viesteistä (yli 1600 kpl) HTML-muotoisen sivukokonaisuuden. Vuoden 2013 alusta Survo-keskustelua on jatkettu entistäkin aktiivisemmin osoitteessa forum.survo.fi. Tervetuloa mukaan!