Skip to content

Commit

Permalink
Fixed #4644: Errors in Export R syntax file - patch provided by apdev…
Browse files Browse the repository at this point in the history 
…ries

Dev: also made R export admin screen look the same as spss export, giving the option to select answer filter

git-svn-id: file:///Users/Shitiz/Downloads/lssvn/source/limesurvey@9204 b72ed6b6-b9f8-46b5-92b4-906544132732
  • Loading branch information
@mennodekker
mennodekker committed Oct 11, 2010
1 parent b85e6e7 commit e8b4fb2
Showing 1 changed file with 174 additions and 116 deletions.
290 changes: 174 additions & 116 deletions admin/export_data_r.php
View file
Original file line number Diff line number Diff line change
Expand Up @@ -71,167 +71,225 @@
);

if (!isset($surveyid)) {$surveyid=returnglobal('sid');}
$filterstate = incompleteAnsFilterstate();

$headerComment = '#$Rev: 8866 $' . " $filterstate.\n";

if (isset($_GET['dldata'])) $subaction = "dldata";
if (isset($_GET['dlstructure'])) $subaction = "dlstructure";

if (!isset($subaction))
{
$exportroutput = browsemenubar($clang->gT('Export results'));
$exportroutput .= "<div class='header'>".$clang->gT("Export result data to R")."</div>\n";
$exportroutput .= "<p style='width:100%;'><ul style='width:300px;margin:0 auto;'><li><a href='$scriptname?action=exportr&amp;sid=$surveyid&amp;subaction=dlstructure'>".$clang->gT("Export R syntax file")."</a></li><li>"
."<a href='$scriptname?action=exportr&amp;sid=$surveyid&amp;subaction=dldata'>".$clang->gT("Export .csv data file")."</a></li></ul></p><br />\n"
."<div class='messagebox'><div class='header'>".$clang->gT("Instructions for the impatient")."</div>"

$exportroutput = browsemenubar($clang->gT('Export results'));
$exportroutput .= "<div class='header'>".$clang->gT("Export result data to R")."</div>\n";

$selecthide="";
$selectshow="";
$selectinc="";
switch ($filterstate) {
case "inc":
$selectinc="selected='selected'";
break;
case "filter":
$selecthide="selected='selected'";
break;
default:
$selectshow="selected='selected'";
}

$exportroutput .= "<form action='$scriptname' id='exportspss' method='get'><ul>\n"
."<li><label for='filterinc'>".$clang->gT("Data selection:")."</label><select id='filterinc' name='filterinc' onchange='this.form.submit();'>\n"
."\t<option value='filter' $selecthide>".$clang->gT("Completed responses only")."</option>\n"
."\t<option value='show' $selectshow>".$clang->gT("All responses")."</option>\n"
."\t<option value='incomplete' $selectinc>".$clang->gT("Incomplete responses only")."</option>\n"
."</select></li>\n";

$exportroutput .= "<input type='hidden' name='sid' value='$surveyid' />\n"
."<input type='hidden' name='action' value='exportr' /></li>\n"
."<li><label for='dlstructure'>" . $clang->gT("Step 1:") . "</label><input type='submit' name='dlstructure' id='dlstructure' value='" . $clang->gT("Export R syntax file") . "'/></li>\n"
."<li><label for='dldata'/>" . $clang->gT("Step 2:") . "</label><input type='submit' name='dldata' id='dldata' value='" . $clang->gT("Export .csv data file") . "'/></li></ul>\n"
."</form>\n"

."<p><div class='messagebox'><div class='header'>".$clang->gT("Instructions for the impatient")."</div>"
."<br/><ol style='margin:0 auto; font-size:8pt;'>"
."<li>".$clang->gT("Download the data and the syntax file.")."</li>"
."<li>".$clang->gT("Save both of them on the R working directory (use getwd() and setwd() on the R command window to get and set it)").".</li>"
."<li>".$clang->gT("digit: source(\"Surveydata_syntax.R\", encoding = \"UTF-8\") on the R command window")."</li>"
."</ol><br />"
.$clang->gT("Your data should be imported now, the data.frame is named \"data\", the variable.labels are attributes of data (\"attributes(data)\$variable.labels\"), like for foreign:read.spss.")
."</div>";
} else {
}
else
{
// Get Base Language:

$language = GetBaseLanguageFromSurveyID($surveyid);
$clang = new limesurvey_lang($language);
require_once ("export_data_functions.php");
}



if ($subaction=='dldata') {
if ($subaction=='dldata')
{
header("Content-Disposition: attachment; filename=survey_".$surveyid."_data_file.csv");
header("Content-type: text/comma-separated-values; charset=UTF-8");
header("Cache-Control: must-revalidate, post-check=0, pre-check=0");
header("Pragma: public");

$na=""; //change to empty string instead of two double quotes to fix warnings on NA
$na=""; //change to empty string instead of two double quotes to fix warnings on NA
spss_export_data($na);

exit;
}

if ($subaction=='dlstructure')
{
header("Content-Disposition: attachment; filename=Surveydata_syntax.R");
header("Content-type: application/download; charset=UTF-8");
header("Cache-Control: must-revalidate, post-check=0, pre-check=0");
header("Pragma: public");

if ($subaction=='dlstructure') {
header("Content-Disposition: attachment; filename=Surveydata_syntax.R");
header("Content-type: application/download; charset=UTF-8");
header("Cache-Control: must-revalidate, post-check=0, pre-check=0");
header("Pragma: public");
echo $headerComment;
echo "data <- read.table(\"survey_".$surveyid
."_data_file.csv\", sep=\",\", quote = \"'\", "
."na.strings=c(\"\",\"\\\"\\\"\"), "
."stringsAsFactors=FALSE)\n\n";
// echo "names(data) <- paste(\"V\",1:dim(data)[2],sep=\"\")\n\n";

// Build array that has to be returned
$fields = spss_fieldmap();
// Build array that has to be returned
$fields = spss_fieldmap("V");

//Now get the query string with all fields to export
$query = spss_getquery();
//Now get the query string with all fields to export
$query = spss_getquery();

$result=db_execute_num($query) or safe_die("Couldn't get results<br />$query<br />".$connect->ErrorMsg()); //Checked
$num_fields = $result->FieldCount();
$result=db_execute_num($query) or safe_die("Couldn't get results<br />$query<br />".$connect->ErrorMsg()); //Checked
$num_fields = $result->FieldCount();

//Now we check if we need to adjust the size of the field or the type of the field
while ($row = $result->FetchRow()) {
$fieldno = 0;
while ($fieldno < $num_fields)
{
//Performance improvement, don't recheck fields that have valuelabels
if (!isset($fields[$fieldno]['answers'])) {
$strTmp=mb_substr(strip_tags_full($row[$fieldno]), 0, $length_data);
$len = mb_strlen($strTmp);
if($len > $fields[$fieldno]['size']) $fields[$fieldno]['size'] = $len;

if (trim($strTmp) != ''){
if ($fields[$fieldno]['SPSStype']=='F' && (my_is_numeric($strTmp)===false || $fields[$fieldno]['size']>16))
{
$fields[$fieldno]['SPSStype']='A';
}
}
}
$fieldno++;
}
}
//Now we check if we need to adjust the size of the field or the type of the field
while ($row = $result->FetchRow()) {
$fieldno = 0;
while ($fieldno < $num_fields)
{
//Performance improvement, don't recheck fields that have valuelabels
if (!isset($fields[$fieldno]['answers'])) {
$strTmp=mb_substr(strip_tags_full($row[$fieldno]), 0, $length_data);
$len = mb_strlen($strTmp);
if($len > $fields[$fieldno]['size']) $fields[$fieldno]['size'] = $len;

/**
* End of DATA print out
*
* Now $fields contains accurate length data, and the DATA LIST can be rendered -- then the contents of the temp file can
* be sent to the client.
*/
echo $headerComment;
echo "data=read.table(\"survey_".$surveyid."_data_file.csv\", sep=\",\", quote = \"'\", na.strings=c(\"\",\"\\\"\\\"\"), stringsAsFactors=FALSE)\n names(data)=paste(\"V\",1:dim(data)[2],sep=\"\")\n";
foreach ($fields as $field){
if($field['SPSStype'] == 'DATETIME23.2') $field['size']='';
if($field['LStype'] == 'N' || $field['LStype']=='K') {
$field['size'].='.'.($field['size']-1);
}
switch ($field['SPSStype']) {
case 'F':
$type="numeric";
break;
case 'A':
$type="character";
break;
case 'DATETIME23.2':
case 'SDATE':
$type="character";
//@TODO set $type to format for date
break;
if (trim($strTmp) != ''){
if ($fields[$fieldno]['SPSStype']=='F' && (my_is_numeric($strTmp)===false || $fields[$fieldno]['size']>16))
{
$fields[$fieldno]['SPSStype']='A';
}
}
}
$fieldno++;
}
}

}
if (!$field['hide']) echo " data[,which(names(data)==\"" . $field['id'] . "\")]=as.$type(data[,which(names(data)==\"" . $field['id'] . "\")])\n";
$errors = "";
$i = 1;
foreach ($fields as $field)
{
if($field['SPSStype'] == 'DATETIME23.2') $field['size']='';
if($field['LStype'] == 'N' || $field['LStype']=='K')
{
$field['size'].='.'.($field['size']-1);
}

//Create the variable labels:
echo "#Define Variable Properties.\n";
foreach ($fields as $field) {
if (!$field['hide']) echo 'attributes(data)$variable.labels[which(names(data)=="' . $field['id'] . '")]="' . addslashes(mb_substr(strip_tags_full($field['VariableLabel']),0,$length_varlabel)) . '"' . "\n";
switch ($field['SPSStype'])
{
case 'F':
$type="numeric";
break;
case 'A':
$type="character";
break;
case 'DATETIME23.2':
case 'SDATE':
$type="character";
//@TODO set $type to format for date
break;
}

// Create our Value Labels!
echo "#Define Value labels.\n";
foreach ($fields as $field) {
if (isset($field['answers'])) {
$answers = $field['answers'];
//print out the value labels!
// data$V14=factor(data$V14,levels=c(1,2,3),labels=c("Yes","No","Uncertain"))
echo 'data$' . $field["id"] . '=factor(data$' . $field["id"] . ',levels=c(';
$str="";
foreach ($answers as $answer) {
if ($field['SPSStype']=="F" && my_is_numeric($answer['code'])) {
$str .= ",{$answer['code']}";
} else {
$str .= ",\"{$answer['code']}\"";
}
}
$str = mb_substr($str,1);
echo $str . '),labels=c(';
$str="";
foreach ($answers as $answer) {
$str .= ",\"{$answer['value']}\"";
}
$str = mb_substr($str,1);
if($field['scale']!=='' && $field['scale'] == 2 ) {
$scale = ",ordered=TRUE";
if (!$field['hide'])
{
echo "data[, " . $i . "] <- "
."as.$type(data[, " . $i . "])\n";

echo 'attributes(data)$variable.labels[' . $i . '] <- "'
. addslashes(
htmlspecialchars_decode(utf8_decode(
mb_substr(
strip_tags_full(
$field['VariableLabel']),0,$length_varlabel)))) // <AdV> added htmlspecialchars_decode
. '"' . "\n";

// Create the value Labels!
if (isset($field['answers']))
{
$answers = $field['answers'];
//print out the value labels!
// data$V14=factor(data$V14,levels=c(1,2,3),labels=c("Yes","No","Uncertain"))
echo 'data[, ' . $i .'] <- factor(data[, ' . $i . '], levels=c(';
$str="";
foreach ($answers as $answer) {
if ($field['SPSStype']=="F" && my_is_numeric($answer['code'])) {
$str .= ", {$answer['code']}";
} else {
$scale = "";
$str .= ", \"{$answer['code']}\"";
}
echo "$str)$scale)\n";
}
}
$str = mb_substr($str,1);
echo $str . '), labels=c(';
$str="";
foreach ($answers as $answer) {
$str .= ", \"{$answer['value']}\"";
}
$str = mb_substr($str,1);
if($field['scale']!=='' && $field['scale'] == 2 ) {
$scale = ", ordered=TRUE";
} else {
$scale = "";
}
echo "$str)$scale)\n";
}

//Rename the Variables (in case somethings goes wrong, we still have the OLD values
$errors = "";
echo "v.names=c(";
foreach ($fields as $field){
if (isset($field['sql_name'])) {
$ftitle = $field['title'];
if (!preg_match ("/^([a-z]|[A-Z])+.*$/", $ftitle)) {
$ftitle = "q_" . $ftitle;
}
$ftitle = str_replace(array("-",":",";","!"), array("_hyph_","_dd_","_dc_","_excl_"), $ftitle);
if (!$field['hide']) {
if ($ftitle != $field['title']) $errors .= "# Variable name was incorrect and was changed from {$field['title']} to $ftitle .\n";
echo "\"". $ftitle . "\",";
//Rename the Variables (in case somethings goes wrong, we still have the OLD values
if (isset($field['sql_name']))
{
$ftitle = $field['title'];
if (!preg_match ("/^([a-z]|[A-Z])+.*$/", $ftitle))
{
$ftitle = "q_" . $ftitle;
}
$ftitle = str_replace(array("-",":",";","!"), array("_hyph_","_dd_","_dc_","_excl_"), $ftitle);
if (!$field['hide'])
{
if ($ftitle != $field['title'])
{
$errors .= "# Variable name was incorrect and was changed from {$field['title']} to $ftitle .\n";
}
echo "names(data)[" . $i . "] <- "
. "\"". $ftitle . "\"\n"; // <AdV> added \n
}
$i++;
}
}
echo "NA); names(data)= v.names[-length(v.names)]\nrm(v.names)\n";
else
{
echo "#sql_name not set\n";
}

}
else
{
echo "#Field hidden\n";
}
echo "\n";

} // end foreach
echo $errors;
exit;
}

?>

0 comments on commit e8b4fb2

Please sign in to comment.