#!/usr/bin/perl use strict; use warnings; use File::Copy; use File::Basename; use Statistics::R; my $directory = $ARGV[0]; my $dir = dirname($directory); my $file = basename($directory); my $train_start = $ARGV[1]; my $train_end = $ARGV[2]; my $test_start = $ARGV[3]; my $test_end = $ARGV[4]; open DATA,"<","$dir/$file" or die "$!"; chomp(my $data = ); close DATA; my @data = split /\t/,$data; my $total = scalar(@data); copy("$dir/$file","$dir/data_$total.txt") or die "$!"; open LOG,">","$dir/log.txt" or die "$!"; my $output = ""; while($total > 2){ my $input = "data_"."$total.txt"; print LOG "$input:\n"; print "$input:\n"; open IN,"<","$dir/$input" or die "$!"; my $drop = $total - 1; $output = "data_"."$drop.txt"; my %drop_acc = (); for my $count (2..$total){ print "$count\t"; &drop($count); my $R = Statistics::R -> new(); $R -> startR; $R -> send(qq'library(class)'); $R -> send(qq'library(e1071)'); $R -> send(qq'svmdata <- read.delim("$dir/$output",header = FALSE,sep = "\t")'); $R -> send(qq'n <- length(svmdata)'); $R -> send(qq'trainset <- svmdata[$train_start:$train_end,2:n]'); $R -> send(qq'trainlabel <- svmdata[$train_start:$train_end,1]'); $R -> send(qq'testset <- svmdata[$test_start:$test_end,2:n]'); $R -> send(qq'testlabel <- svmdata[$test_start:$test_end,1]'); $R -> send(qq'model <- svm(trainset,trainlabel,type="C-classification")'); $R -> send(qq'predlabel <- predict(model,testset)'); $R -> send(qq'result <- table(predlabel,testlabel)'); $R -> send(qq'acc <- (result[1,1]+result[2,2])/(result[1,1]+result[1,2]+result[2,1]+result[2,2])'); $R -> send(qq'print(acc)'); my $read = $R -> read; $read =~ s/\[\d\]\s+(\d+)/$1/g; print "$read\n"; $drop_acc{$count} = $read; $R -> stopR(); } my @keys = sort{$drop_acc{$b} <=> $drop_acc{$a}} keys %drop_acc; for(@keys){print LOG "$_\t$drop_acc{$_}\n";} print LOG "drop: $keys[0]\n"; print "sort:\n"; for(@keys){print "$_\t$drop_acc{$_}\n";} print "drop: $keys[0]\n"; &drop($keys[0]); $total--; } sub drop { my $drop = shift; open OUT,">","$dir/$output" or die "$!"; seek IN,0,0; while(){ chomp; my @data = split /\t/; my $out = $data[0]; for my $index (1..$total-1){ $out = join("\t",$out,$data[$index]) if $index+1 != $drop; } print OUT "$out\n"; } close OUT; }