~l3on/ubuntu/precise/rkward/rebuild1

« back to all changes in this revision

Viewing changes to rkward/plugins/00saveload/import/import_spss.php

  • Committer: Bazaar Package Importer
  • Author(s): Thomas Friedrichsmeier
  • Date: 2008-04-20 21:30:00 UTC
  • mfrom: (1.2.2 upstream) (3.1.9 hardy)
  • Revision ID: james.westby@ubuntu.com-20080420213000-fs4i8efmfc793bnn
new upstream release
closes: #475175
closes: #463348
closes: #475982

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
<?php
 
2
function preprocess () { ?>
 
3
require (foreign)
 
4
<?      if (getRK_val ("do_locale_conversion")) { ?>
 
5
 
 
6
# helper function to convert all strings to the current encoding
 
7
iconv.recursive <- function (x, from) {
 
8
        attribs <- attributes (x);
 
9
        if (is.character (x)) {
 
10
                x <- iconv (x, from=from, to="", sub="")
 
11
        } else if (is.list (x)) {
 
12
                x <- lapply (x, function (sub) iconv.recursive (sub, from))
 
13
        }
 
14
        # convert factor levels and all other attributes
 
15
        attributes (x) <- lapply (attribs, function (sub) iconv.recursive (sub, from))
 
16
        x
 
17
}
 
18
<?      }
 
19
}
 
20
 
 
21
function calculate () {
 
22
        if (getRK_val ("data_frame")) {
 
23
                $data_frame = true;
 
24
                $data_frame_opt = ", to.data.frame=TRUE";
 
25
        }
 
26
 
 
27
        if (getRK_val ("use_labels")) {
 
28
                $labels_opt .= ", max.value.labels=" . getRK_val ("labels_limit");
 
29
                if (getRK_val ("trim_labels")) $labels_opt .= ", trim.factor.names=TRUE";
 
30
        } else {
 
31
                $labels_opt = ", use.value.labels=FALSE";
 
32
        }
 
33
 
 
34
        $object = getRK_val ("saveto");
 
35
?>
 
36
data <- read.spss ("<? getRK ("file"); ?>"<? echo ($data_frame_opt); echo ($labels_opt); ?>)
 
37
<?      if (getRK_val ("do_locale_conversion")) {
 
38
                $from_locale = getRK_val ("encoding");
 
39
                if ($from_locale == "other") {
 
40
                        $from_locale = getRK_val ("user_encoding");
 
41
                } ?>
 
42
 
 
43
# convert all strings to the current encoding
 
44
data <- iconv.recursive (data, from="<? echo ($from_locale); ?>")
 
45
<?      }
 
46
        if (getRK_val ("convert_var_labels")) { ?>
 
47
 
 
48
# set variable labels for use in RKWard
 
49
labels <- attr (data, "variable.labels");
 
50
if (!is.null (labels)) {
 
51
        for (i in 1:length (labels)) {
 
52
                col <- make.names (names (labels[i]))
 
53
                if (!is.null (col)) {
 
54
                        rk.set.label (data[[col]], labels[i])
 
55
                }
 
56
        }
 
57
}
 
58
<?      } ?>
 
59
 
 
60
<? echo ($object); ?> <<- data          # assign to globalenv()
 
61
<?
 
62
        if (getRK_val ("doedit") && $data_frame) { ?>
 
63
rk.edit (<? echo ($object); ?>)
 
64
<?      }
 
65
}
 
66
 
 
67
function printout () {
 
68
}
 
69
?>