Image

head

code

Html

item

root

para

L<Examples| file:../examples/index.podlite>


L<Download |file:../download/index.podlite>


React

=begin React :component<HeaderCol> :id<menu> 
=para L<Documentation|/doc/introduction>
=para L<Modules| /mods>
=para L<Examples| file:../examples/index.podlite>
=para L<Download |file:../download/index.podlite>
=para L<About|file:../about/index.podlite>
=para 🔍 K<⌘K>/K<ctrl-K>
=end React


HEADER

FOOTER

README

use v6;
use NativeCall;
use Algorithm::LibSVM::Problem;
use Algorithm::LibSVM::Parameter;
use Algorithm::LibSVM::Model;
use Algorithm::LibSVM::Grammar;
use Algorithm::LibSVM::Actions;

unit class Algorithm::LibSVM:auth<zef:titsuki>:ver<0.0.16>;

my constant $library = %?RESOURCES<libraries/svm>.Str;

my sub svm_cross_validation(Algorithm::LibSVM::CProblem, Algorithm::LibSVM::Parameter, int32, CArray[num64]) is native($library) { * }
my sub svm_train(Algorithm::LibSVM::CProblem, Algorithm::LibSVM::Parameter --> Algorithm::LibSVM::Model) is native($library) { * }
my sub svm_check_parameter(Algorithm::LibSVM::CProblem, Algorithm::LibSVM::Parameter --> Str) is native($library) { * }
my sub print_string_stdout(Str --> Pointer[void]) is native($library) { * }
my sub svm_set_print_string_function(&print_func (Str --> Pointer[void])) is native($library) { * }
my sub svm_set_srand(int32) is native($library) { * }

submethod BUILD(Bool :$verbose? = False, Int :$seed = 1) {
    unless $verbose {
        my $f = sub (Str --> Pointer[void]) { Nil };
        svm_set_print_string_function($f);
    }
    svm_set_srand($seed);
}

method cross-validation(Algorithm::LibSVM::Problem $problem, Algorithm::LibSVM::Parameter $param, Int $nr-fold --> List) {
    if $param.gamma == 0 && $problem.nr-feature > 0 {
        $param.gamma((1.0 / $problem.nr-feature).Num);
    }
    my $target = CArray[num64].allocate: $problem.l;
    svm_cross_validation($problem.as-c, $param, $nr-fold, $target);
    $target.list
}

method check-parameter(Algorithm::LibSVM::Problem $problem, Algorithm::LibSVM::Parameter $param --> Bool) {
    my $msg = svm_check_parameter($problem.as-c, $param);
    die "$msg" if $msg.defined;
    True
}

method train(Algorithm::LibSVM::Problem $problem, Algorithm::LibSVM::Parameter $param --> Algorithm::LibSVM::Model) {
    if $param.gamma == 0 && $problem.nr-feature > 0 {
        $param.gamma((1.0 / $problem.nr-feature).Num);
    }
    svm_train($problem.as-c, $param) if self.check-parameter($problem, $param);
}

my sub svm_load_model(Str --> Algorithm::LibSVM::Model) is native($library) { * }

method load-model(Str $filename --> Algorithm::LibSVM::Model) {
    svm_load_model($filename)
}

method evaluate(@true-values, @predicted-values --> Hash) {
    if @true-values.elems != @predicted-values.elems {
        die 'ERROR: @true-values.elems != @predicted-values.elems';
    }
    my ($total-correct, $total-error) = 0, 0;
    my ($sum-p, $sum-t, $sum-pp, $sum-tt, $sum-pt) = 0, 0, 0, 0, 0;
    for @true-values Z @predicted-values -> ($t, $p) {
        $total-correct++ if $p == $t;
        $total-error += ($p - $t) ** 2;
        $sum-p += $p;
        $sum-t += $t;
        $sum-pp += $p ** 2;
        $sum-tt += $t ** 2;
        $sum-pt += $p * $t;
    }

    my Num $num-t = @true-values.elems.Num;
    my Num $accuracy = 100.0 * $total-correct / $num-t;
    my Num $mean-squared-error = $total-error / $num-t;

    my Num $denom =  ($num-t * $sum-pt - $sum-p ** 2) * ($num-t * $sum-pt - $sum-t ** 2);
    my Num $squared-correlation-coefficient
    = do if -1e-20 <= $denom <= 1e-20 {
        Num;
    } else {
        ($num-t * $sum-pt - $sum-p * $sum-t) ** 2 / $denom;
    }
    { acc => $accuracy, mse =>  $mean-squared-error, scc =>  $squared-correlation-coefficient }
}

sub parse-libsvmformat(Str $text --> List) is export {
    Algorithm::LibSVM::Grammar.parse($text, actions => Algorithm::LibSVM::Actions).made or die
}

my constant $msg = "Algorithm::LibSVM::Problem.from-file";
multi method load-problem(\lines --> Algorithm::LibSVM::Problem) is DEPRECATED($msg) {
    Algorithm::LibSVM::Problem._load-problem(lines)
}

multi method load-problem(Str $filename --> Algorithm::LibSVM::Problem) is DEPRECATED($msg) {
    Algorithm::LibSVM::Problem._load-problem($filename.IO.lines)
}



Algorithm::LibSVM - A Raku bindings for libsvm


use Algorithm::LibSVM;
use Algorithm::LibSVM::Parameter;
use Algorithm::LibSVM::Problem;
use Algorithm::LibSVM::Model;


my $libsvm = Algorithm::LibSVM.new;
my Algorithm::LibSVM::Parameter $parameter .= new(svm-type => C_SVC,
                                                  kernel-type => RBF);
# heart_scale is here: https://www.csie.ntu.edu.tw/~cjlin/libsvmtools/datasets/binary/heart_scale
my Algorithm::LibSVM::Problem $problem = Algorithm::LibSVM::Problem.from-file('heart_scale');
my @r = $libsvm.cross-validation($problem, $parameter, 10);
$libsvm.evaluate($problem.y, @r).say; # {acc => 81.1111111111111, mse => 0.755555555555556, scc => 1.01157627463546}


sub gen-train {
  my $max-x = 1;
  my $min-x = -1;
  my $max-y = 1;
  my $min-y = -1;
  my @tmp-x;
  my @tmp-y;
  do for ^300 {
      my $x = $min-x + rand * ($max-x - $min-x);
      my $y = $min-y + rand * ($max-y - $min-y);


my $label = do given $x, $y {
    when ($x - 0.5) ** 2 + ($y - 0.5) ** 2 <= 0.2 {
        1
    }
    when ($x - -0.5) ** 2 + ($y - -0.5) ** 2 <= 0.2 {
        -1
    }
    default { Nil }
}
if $label.defined {
    @tmp-y.push: $label;
    @tmp-x.push: [$x, $y];
}
}
# Note that @x must be a shaped one.
my @x[+@tmp-x;2] = @tmp-x.clone;
my @y = @tmp-y.clone;
(@x, @y)
}


my (@train-x, @train-y) := gen-train;
my @test-x = 1 => 0.5e0, 2 => 0.5e0;
my $libsvm = Algorithm::LibSVM.new;
my Algorithm::LibSVM::Parameter $parameter .= new(svm-type => C_SVC,
                                                  kernel-type => LINEAR);
my Algorithm::LibSVM::Problem $problem = Algorithm::LibSVM::Problem.from-matrix(@train-x, @train-y);
my $model = $libsvm.train($problem, $parameter);
say $model.predict(features => @test-x)<label> # 1


Algorithm::LibSVM is a Raku bindings for libsvm.


method cross-validation(Algorithm::LibSVM::Problem $problem, Algorithm::LibSVM::Parameter $param, Int $nr-fold --> List)


Conducts C<$nr-fold>-fold cross validation and returns predicted values.


method train(Algorithm::LibSVM::Problem $problem, Algorithm::LibSVM::Parameter $param --> Algorithm::LibSVM::Model)


multi method load-problem(\lines --> Algorithm::LibSVM::Problem)
multi method load-problem(Str $filename --> Algorithm::LibSVM::Problem)


method load-model(Str $filename --> Algorithm::LibSVM::Model)


method evaluate(@true-values, @predicted-values --> Hash)


Evaluates the performance of the three metrics (i.e. accuracy, mean squared error and squared correlation coefficient)


Returns the maximum index of all the features.


sub parse-libsvmformat(Str $text --> List) is export


Is a helper routine for handling libsvm-format text.


As a workaround for L<RT130187|https://rt.perl.org/Public/Bug/Display.html?id=130187>, I applied the patch programs (e.g. L<src/3.22/svm.cpp.patch>) for the sake of disabling random access of the problematic array.


Sadly to say, those patches drastically increase the complexity of using C<PRECOMPUTED> kernel.


LibSVM

Algorithm::LCS - Implementation of the longest common subsequence algorithm


=begin code :lang<raku>

use Algorithm::LCS;

# regular usage
say lcs(<A B C D E F G>, <A C F H J>); # prints T<A C F>

# custom comparator via :compare
say lcs(<A B C>, <D C F>, :compare(&infix:<eq>));

# extra special custom comparison via :compare-i
my @a        = slurp('one.txt');
my @b        = slurp('two.txt');
my @a-hashed = @a.map({ hash-algorithm($_) });
my @b-hashed = @b.map({ hash-algorithm($_) });
say lcs(@a, @b, :compare-i({ @a-hashed[$^i] eqv @b-hashed[$^j] }));

=end code


This module contains a single subroutine, C<lcs>, that calculates
the longest common subsequence between two sequences of data.  C<lcs>
takes two lists as required parameters; you may also specify the comparison
function (which defaults to C<eqv>) via the C<&compare> named parameter).


Sometimes you may want to maintain a parallel array of information to
consult during calculation (for example, if you're comparing long lines
of a file, and you'd like a speedup by comparing their hashes rather than
their contents); for that, you may use the C<&compare-i> named argumeny



my sub strip-prefix(@a, @b, &compare-i) {
    my $i = 0;
    my @prefix;

    while $i < (@a & @b) && &compare-i($i, $i) {
        @prefix.push: @a[$i++];
    }

    @prefix
}

my sub strip-suffix(@a, @b, &compare-i) {
    # XXX could be optimized, but this is easy for now
    strip-prefix(@a.reverse, @b.reverse, -> $i, $j {
        &compare-i(@a.end - $i, @b.end - $j)
    }).reverse
}

my sub build-lcs-matrix(@a, @b, &compare-i) {
    my @matrix  = 0 xx ((@a + 1) * (@b + 1));
    my $row-len = @a + 1;

    for 1 .. @b X 1 .. @a -> ($row, $offset) {
        my $index = $row * $row-len + $offset;

        if &compare-i($offset - 1, $row - 1) {
            @matrix[$index] = @matrix[$index - $row-len - 1] + 1;
        } else {
            @matrix[$index] = [max] @matrix[ $index - $row-len, $index - 1 ];
        }
    }

    @matrix
}

#| Returns the longest common subsequence of two sequences of data.
my sub lcs(
    @a,                     #= The first sequence
    @b,                     #= The second sequence
    :&compare=&infix:<eqv>, #= The comparison function (defaults to C<eqv>)
    :&compare-i is copy     #= The compare-by-index function (defaults to using &compare)
) is export {
    unless &compare-i.defined {
        &compare-i = -> $i, $j {
            &compare(@a[$i], @b[$j])
        };
    }

    my @prefix = strip-prefix(@a, @b, &compare-i);
    my @suffix = strip-suffix(@a[+@prefix .. *], @b[+@prefix .. *], -> $i, $j {
        &compare-i($i + @prefix, $j + @prefix)
    });
    my @a-middle = @a[+@prefix .. @a.end - @suffix];
    my @b-middle = @b[+@prefix .. @b.end - @suffix];

    if @a-middle && @b-middle {
        my @matrix = build-lcs-matrix(@a-middle, @b-middle, -> $i, $j {
            &compare-i($i + @prefix, $j + @prefix)
        });

        my $matrix-row-len = @a-middle + 1;
        my $i = @matrix.end;

        my @result := gather while $i > 0 && @matrix[$i] > 0 {
            my $current-length  = @matrix[$i];
            my $next-row-length = @matrix[$i - $matrix-row-len];
            my $next-col-length = @matrix[$i - 1];

            if $current-length > $next-row-length && $next-row-length == $next-col-length {
                take @b-middle[$i div $matrix-row-len - 1];
                $i -= $matrix-row-len + 1;
            }
            elsif $next-row-length < $next-col-length {
                $i--;
            }
            elsif $next-col-length <= $next-row-length {
                $i -= $matrix-row-len;
            }
            else {
                die "this should never be reached!";
            }
        }.list;

        ( @prefix, @result.reverse, @suffix ).flat
    }
    else {
        ( @prefix, @suffix ).flat
    }
}



L<Wikipedia article|http://en.wikipedia.org/wiki/Longest_common_subsequence_problem>


This library is free software; you can redistribute it and/or modify it under the MIT license.


The Raku Knowledge Base


=begin React :component<HeaderCol> :id<footer>  
=begin nested :!nested
=item1 B<Language>
    =item2 L<Get started|file:../getting-started/getting-started.podlite>
    =item2 L<Why Raku?|/doc/language/faq#Why-should-I-learn-Raku-What's-so-great-about-it>
    =item2 L<Try Raku|https://glot.io/new/raku>
    =item2 L<Raku cheat sheet|https://github.com/Raku/mu/blob/master/docs/Perl6/Cheatsheet/cheatsheet.txt>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<Raku on Exercism|https://exercism.org/tracks/raku>
    =item2 L<Wikipedia|https://en.wikipedia.org/wiki/Raku_(programming_language)>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=begin nested :!nested

=item1 B<L<Documentation|/doc>>
    =item2 L<Getting started, Migration guides from other languages, & Tutorials | file:../doc/introduction.podlite>
    =item2 L<Language References|file:../doc/reference.podlite>
    =item2 L<Type Reference| file:../doc/types.podlite>
    =item2 L<Miscellaneous| file:../doc/miscellaneous.podlite>
    =item2 L<FAQs (Frequently Asked Questions)|/doc/language/faq>
    =item2 L<Community|/doc/language/community>
    =item2 L<The list of all documents|file:../doc/index.podlite>

=item1 B<Resources>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>

=end nested
=begin nested :!nested

=item1 B<Resoures>
    =item2 L<Download | file:../download/index.podlite>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=item1 B<Learning>
    =item2 L<The Raku Guide|https://raku.guide/>
    =item2 L<Wikibook |https://en.wikibooks.org/wiki/Raku_Programming>
    =item2 L<Books |https://perl6book.com/>
    =item2 L<Rosetta Code | https://www.raku.org/community/rosettacode>
    =item2 L<Learn Raku in Y minutes|https://learnxinyminutes.com/docs/raku/>
    =item2 L<Golfing |https://github.com/AlexDaniel/raku-golf-cheatsheet>
=end nested
=begin nested :!nested

=item1 B<Explore>
    =item2 L<Raku Blog Aggregator|https://planet.raku.org/>
    =item2 L<Rakudo Weekly|https://rakudoweekly.blog/>
    =item2 L<The Weekly Challenge |https://perlweeklychallenge.org/>
    =item2 L<Raku Advent Calendar|https://raku-advent.blog/>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>
    =item2 L<empty|#>

=end nested
=end React


=begin React :component<CookieConsent> :id<CookieConsent> :buttonCaption("Got it!")
=para
This website uses cookies for analytics.
=end React


README

NAME

SYNOPSIS

DESCRIPTION

SUBROUTINES

sub lcs

class Mu $

class Mu $

class Mu $

class Mu $

SEE ALSO

AUTHORS

COPYRIGHT AND LICENSE

Algorithm::LCS v0.1.1

Authors

License

Dependencies

Test Dependencies

Provides

Documentation