From 9544a9e2bdd3d7e47d6006ca9095a7138594860b Mon Sep 17 00:00:00 2001 From: Randy Lauen Date: Fri, 26 Jul 2019 18:00:53 -0500 Subject: solutions for challenges 2 and 3 --- challenge-018/randy-lauen/perl6/ch-2.p6 | 67 ++++++++++++++++++++++++++ challenge-018/randy-lauen/perl6/ch-3.p6 | 85 +++++++++++++++++++++++++++++++++ 2 files changed, 152 insertions(+) create mode 100644 challenge-018/randy-lauen/perl6/ch-2.p6 create mode 100644 challenge-018/randy-lauen/perl6/ch-3.p6 diff --git a/challenge-018/randy-lauen/perl6/ch-2.p6 b/challenge-018/randy-lauen/perl6/ch-2.p6 new file mode 100644 index 0000000000..2cb2dafdc1 --- /dev/null +++ b/challenge-018/randy-lauen/perl6/ch-2.p6 @@ -0,0 +1,67 @@ +#!/usr/bin/env perl6 + +=begin DESC + +Write a script to implement Priority Queue. It is like regular queue except each element +has a priority associated with it. In a priority queue, an element with high priority is +served before an element with low priority. It should serve the following operations: + +=item 1) is_empty + check whether the queue has no elements. +=item 2) insert_with_priority + add an element to the queue with an associated priority. +=item 3) pull_highest_priority_element + remove the element from the queue that has the highest priority, and return it. + If two elements have the same priority, then return element added first. + +=end DESC + +class ÜberNaïvePriorityQueue { + has @!elements; + + method is-empty() { + return @!elements.elems == 0; + } + + method insert-with-priority( $value, $priority ) { + @!elements.push( %( :$value, :$priority ) ); + } + + method pull-highest-priority-element() { + return if self.is-empty; + + # Find the first highest priority element. + my $max-pair = @!elements.map( { . } ).maxpairs.first; + + # Remove and return the first element with the highest priority. + return @!elements.splice( $max-pair.key, 1 ).first.; + } +} + + +use Test; + +my $q = ÜberNaïvePriorityQueue.new; +ok $q.is-empty, 'q is empty'; + +my @cases = + # ( value, priority ) + ( 'a', 17 ), + ( 'x', 33 ), + ( 'y', -1 ), + ( 'b', 17 ), +; +for @cases -> $case { + $q.insert-with-priority( |@$case ); +} + +nok $q.is-empty, 'q is not empty'; +is $q.pull-highest-priority-element, 'x', 'x is highest'; +is $q.pull-highest-priority-element, 'a', 'a is next highest'; +is $q.pull-highest-priority-element, 'b', 'b is same priority, but second'; +is $q.pull-highest-priority-element, 'y', 'y is lowest'; +ok $q.is-empty, 'q is empty'; + +exit 0; + + diff --git a/challenge-018/randy-lauen/perl6/ch-3.p6 b/challenge-018/randy-lauen/perl6/ch-3.p6 new file mode 100644 index 0000000000..f901f98d38 --- /dev/null +++ b/challenge-018/randy-lauen/perl6/ch-3.p6 @@ -0,0 +1,85 @@ +#!/usr/bin/env perl6 + +=begin SYNOPSIS + +Challenge 3: Write a script to use BabelNet API. + +This script attempts to output a random "Six degrees of BabelNet" feature +for a given word or phrase. + +Usage: + ./ch-3.p6 --key=KEY --word='Larry Wall' + +Example output: + $ perl6 ch-3.p6 --key=KEY --word='Larry Wall' + 1. Initial: Larry_Wall (bn:00992148n) => Larry Wall is a computer programmer and author. + 2. related: Perl_module (bn:03320928n) => A Perl module is a discrete component of software for the Perl programming language. + 3. related: class_(computer_programming) (bn:03608262n) => In object-oriented programming, a class is an extensible program-code-template for creating objects, providing initial values for state and implementations of behavior. + 4. related: word_(computer_architecture) (bn:00852566n) => In computing, a word is the natural unit of data used by a particular processor design. + 5. related: kilobit (bn:00048868n) => A unit of information equal to 1000 bits + 6. is-a: computer_memory_unit (bn:00021484n) => A unit for measuring computer memory + +=end SYNOPSIS + +use Cro::HTTP::Client; +use URI::Encode; + +class BabelNet { + has $.key; + has $.language = 'EN'; + has $!client = Cro::HTTP::Client.new( + :http('1.1'), # See https://github.com/croservices/cro-http/issues/74 + :Content-Type('application/json'), + :base-uri('https://babelnet.io'), + ); + + # Returns the synset ids for the given word. + method get-synset-ids( $word ) { + return self!get-json( "/v5/getSynsetIds?lemma=$word&searchLang=$!language&key=$!key" ); + } + + # Returns the JSON of a Synset. + method get-synset( $synset-id ) { + return self!get-json( "/v5/getSynset?id=$synset-id&key=$!key" ); + } + + # Returns the JSON of all outgoing edges. + method get-outgoing-edges( $synset-id ) { + return self!get-json( "/v5/getOutgoingEdges?id=$synset-id&key=$!key" ); + } + + method !get-json( $uri ) { + my $encoded = uri_encode($uri); + my $response = await $!client.get( $encoded ); + return await $response.body; + } +} + + +sub MAIN( :$key!, :$word!, :$depth = 6 ) { + my $babel = BabelNet.new( :$key ); + my $synset-id = $babel.get-synset-ids( $word ).first.; + die "Could not find a synset-id for '$word'" if !$synset-id; + + for ( ^$depth ) -> $n { + my $relationship = 'Initial'; + if ( $n > 0 ) { + # Pick a random outgoing edge, limited by English. + my $random-edge = $babel.get-outgoing-edges( $synset-id ).grep( { . eq 'EN' } ).pick; + die "No random edges for $synset-id" if !$random-edge; + $relationship = $random-edge; + $synset-id = $random-edge; + } + + # Find the name and definition of the current synset-id. + my $synset = $babel.get-synset( $synset-id ); + die "No senses/glosses for $synset-id" unless $synset && $synset; + + my $name = $synset[0]; + my $definition = $synset[0]; + say ++$, ". $relationship: $name ($synset-id) => $definition"; + sleep 2; # Avoid flooding the server with our requests + } +} + + -- cgit