Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re^5: [challenge] Nested autocompletion -- winner program unveiled to me

by Discipulus (Canon)
on Feb 24, 2023 at 11:10 UTC ( [id://11150576] : note . print w/replies, xml ) Need Help??


in reply to Re^4: [challenge] Nested autocompletion -- results and some question
in thread [challenge] Nested autocompletion

Hello tybalt89 and..

> Does this help understanding of the regexes that were used?

..thanks! yes it helps a lot.

I have modified your code to emit debug informations if invoked with an argument. I left your precious comment about regexes and passed it to perltidy

#!/usr/bin/perl use strict; # original code by tybalt89 https://perlmonks.org/?node_i +d=11150326 use warnings; # constant autocomplete use List::Util qw( uniq ); use Term::ReadKey; $| = 1; print "PID $$\n"; my $debug = $ARGV[0] ? 1 : 0; my @animals = (qw( cow camel dog cat )); my @foods = (qw( fish pasture meat )); my @places = (qw( wood sea desert )); my $commands = { select => { completion_list => \@animals, commands => { give => { completion_list => \@foods, }, take_to => { completion_list => \@places, }, }, }, kill => { completion_list => \@animals, } }; my $completed = autocomplete( $commands, 'auto> ' ); print $completed ? "\nThe user entered: $completed\n" : "\nEscape\n"; exit; ###################################################################### sub autocomplete { print "START initialization\n" if $debug; my $commands = shift; my $prompt = shift // '> '; my $lines = ref $commands ? join "\n", lines($commands), '' : $ +commands; my $input = ''; if ($debug) { print "\$prompt = [$prompt]\n\$lines = [$lines]\n"; print "END initialization\n\n" if $debug; } my ( $clearline, $color, $reset ) = ( "\e[G\e[K", "\e[32m", "\e[m" + ); # Control Sequence Introducer, or CSI is: \e[ # clearline: CSI n G CHA Cursor Horizontal Absolute Moves + the cursor to column n (default 1) # color : CSI n m, named Select Graphic Rendition (SGR) where 3 +2 is foregroound green # reset : CSI m is treated as CSI 0 m (reset / normal) ReadMode 'raw'; eval { while () { $input = "$input\n$lines" =~ /^(.*).*\n(?:.*\n)*\1/ ? $1 : + ''; #tybalt89: Trims back $input so it only contains a string +that exists in one of #the valid lines. It's looking for the longest initial str +ing that also #starts one of the other lines. The (?:.*\n)* allows for s +kipping over #any lines that do not match. print "\$input 1 = [$input] line: " . __LINE__ . "\n" if $ +debug; $input = $lines =~ s/^(?!\Q$input\E).*\n//gmr =~ #tybalt89: Removes from $lines any line that does not star +t with $input. Returns #a multiline string where every line starts with $input. /^(.*).*\n(?:\1.*\n)*\z/ ? $1 : ''; #tybalt89: Finds the longest initial substring that starts + every line. This will #extend the match until the next decision point that requi +res user input. print "\$input 2 = [$input] line: " . __LINE__ . "\n" if $ +debug; my $words = join ' ', sort +uniq $lines =~ /^\Q$input\E ?( +\S+)/gm; #tybalt89: Finds the next word after the matching part of +each valid line. print "\$words = [$words] line: " . __LINE__ . "\n" if $de +bug; $lines =~ /^$input\n/m and $words = '*** Completed!'; #tybalt89: Matches $input against each valid line looking +for a complete line match. my $backup = "\e[" . ( 2 + length $words ) . "D"; # Control Sequence Introducer, or CSI: \e[ + number + D(c +ursor back) print "\n\$backup = [CURSOR BACK 2 + length \$words ( 2 + +" . ( length $words ) . " )] line: " . __LINE__ . "\n" if $debug; print "$clearline$prompt$input $color$words$reset$backup" +; my $char = ReadKey(0); # next unless defined $char; # you need this only if un +sane ReadKey -1 # catch ESC and CTRL-C if ( $debug and $char =~ tr/\e\cc// ){ print "\n***ESC or CTRL-C was inserted! Clearing \$inp +ut and exiting the loop\n"; $input = ''; last; } else { $char =~ tr/\e\cc// and $input = '', last; } # catch ENTER if ( $debug and $char =~ tr/\n\r// ){ print "\n***ENTER was inserted!\n"; if ( $lines =~ /^$input$/m ){ print "\$line matches \$input: FINISH\n"; last; } else { print "\$line does NOT matches \$input: NEXT\n +"; next; } } else { $char =~ tr/\n\r// and $lines =~ /^$input$/m ? last : +next; } # catch space if ( $debug and $char =~ tr/ -~// ){ print "\n***SPACE (or - or ~) catched and removed\n"; $input .= $char; } else { $char =~ tr/ -~// and $input .= $char; } print "\nINPUT=> \$char = [".( $char =~ /[\b\x7f]/ ? '**BA +CKSPACE**' : $char)."] line: " . __LINE__ . "\n" # $char =~ tr/\b\x7f// takes a list of chars # $char =~ /[\b\x7f]/ \b in regexex is word boundary, but + inside a char class is backspace # see https://perldoc.perl.org/perlrebackslash if $debug; # if ( $char =~ tr/\b// ) # also this seems to work for + backspace if ( $char =~ tr/\b\x7f// ) # backspace { my $match = 1 + ( () = $lines =~ /^\Q$input\E/gm ); #tybalt89: Counts how many lines are still valid match +es, that is they are still #possibilities that require a user decision at this po +int. Adds 1 #because we need to go back to the previous decision p +oint which will #(by definition) have at least one more valid match. $input = "$input\n$lines" =~ /^(.*).*\n(?:(?:(?!\1).*\n)*\1.*\n){$match}/ ? $1 : +''; #tybalt89: Finds the longest initial substring that al +so is the initial substring #of $match following lines. Lines that do not start wi +th the candidate #initial match are skipped by (?:(?!\1).*\n)* . This +longest initial #substring is the previous decision point, and is then + stored into $input. } print "======> iteration ".$debug++."\n\n" if $debug; } 1; }; my $error = $@; ReadMode 'restore'; print "$error\n"; return $input; } sub lines { my $cmd = shift or return ''; map s/ +$//r, map { my $key = $_; # fun triple map nesting map { my $prev = $_; map "$key $_ $prev", @{ $cmd->{$key}{completion_list} }; } lines( $cmd->{$key}{commands} ) } keys %$cmd; }

Here the output of perl autocomplete-nested-winner-unveiled.pl 1 if I enter the sequence: k BACKSPACE s c a m t ENTER d ENTER

START initialization $prompt = [auto> ] $lines = [kill cow kill camel kill dog kill cat select cow give fish select camel give fish select dog give fish select cat give fish select cow give pasture select camel give pasture select dog give pasture select cat give pasture select cow give meat select camel give meat select dog give meat select cat give meat select cow take_to wood select camel take_to wood select dog take_to wood select cat take_to wood select cow take_to sea select camel take_to sea select dog take_to sea select cat take_to sea select cow take_to desert select camel take_to desert select dog take_to desert select cat take_to desert ] END initialization $input 1 = [] line: 55 $input 2 = [] line: 62 $words = [kill select] line: 65 $backup = [CURSOR BACK 2 + length $words ( 2 + 11 )] line: 73 auto> kill select ***SPACE (or - or ~) catched and removed INPUT=> $char = [k] line: 110 ======> iteration 1 $input 1 = [k] line: 55 $input 2 = [kill ] line: 62 $words = [camel cat cow dog] line: 65 $backup = [CURSOR BACK 2 + length $words ( 2 + 17 )] line: 73 auto> kill camel cat cow dog INPUT=> $char = [**BACKSPACE**] line: 110 ======> iteration 2 $input 1 = [] line: 55 $input 2 = [] line: 62 $words = [kill select] line: 65 $backup = [CURSOR BACK 2 + length $words ( 2 + 11 )] line: 73 auto> kill select ***SPACE (or - or ~) catched and removed INPUT=> $char = [s] line: 110 ======> iteration 3 $input 1 = [s] line: 55 $input 2 = [select ] line: 62 $words = [camel cat cow dog] line: 65 $backup = [CURSOR BACK 2 + length $words ( 2 + 17 )] line: 73 auto> select camel cat cow dog ***SPACE (or - or ~) catched and removed INPUT=> $char = [c] line: 110 ======> iteration 4 $input 1 = [select c] line: 55 $input 2 = [select c] line: 62 $words = [amel at ow] line: 65 $backup = [CURSOR BACK 2 + length $words ( 2 + 10 )] line: 73 auto> select c amel at ow ***SPACE (or - or ~) catched and removed INPUT=> $char = [a] line: 110 ======> iteration 5 $input 1 = [select ca] line: 55 $input 2 = [select ca] line: 62 $words = [mel t] line: 65 $backup = [CURSOR BACK 2 + length $words ( 2 + 5 )] line: 73 auto> select ca mel t ***SPACE (or - or ~) catched and removed INPUT=> $char = [m] line: 110 ======> iteration 6 $input 1 = [select cam] line: 55 $input 2 = [select camel ] line: 62 $words = [give take_to] line: 65 $backup = [CURSOR BACK 2 + length $words ( 2 + 12 )] line: 73 auto> select camel give take_to ***SPACE (or - or ~) catched and removed INPUT=> $char = [t] line: 110 ======> iteration 7 $input 1 = [select camel t] line: 55 $input 2 = [select camel take_to ] line: 62 $words = [desert sea wood] line: 65 $backup = [CURSOR BACK 2 + length $words ( 2 + 15 )] line: 73 auto> select camel take_to desert sea wood ***ENTER was inserted! $line does NOT matches $input: NEXT $input 1 = [select camel take_to ] line: 55 $input 2 = [select camel take_to ] line: 62 $words = [desert sea wood] line: 65 $backup = [CURSOR BACK 2 + length $words ( 2 + 15 )] line: 73 auto> select camel take_to desert sea wood ***SPACE (or - or ~) catched and removed INPUT=> $char = [d] line: 110 ======> iteration 8 $input 1 = [select camel take_to d] line: 55 $input 2 = [select camel take_to desert] line: 62 $words = [] line: 65 $backup = [CURSOR BACK 2 + length $words ( 2 + 14 )] line: 73 auto> select camel take_to desert *** Completed! ***ENTER was inserted! $line matches $input: FINISH The user entered: select camel take_to desert

Some minor doubts:

  • what -~ in $char =~ tr/ -~// and $input .= $char are for?
  • $char =~ tr/\b\x7f// catches both backspace and delete choroba in the chat told some terminal mess them up. Is this the reason to catch them both?

The code implementing the backspace is wizardry :)

The multiline as only datastructure needed is very nice, I wonder how scalable can be, but works very nicely in this case.

Thanks again!

L*

There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

Replies are listed 'Best First'.
Re^6: [challenge] Nested autocompletion -- winner program unveiled to me
by tybalt89 (Monsignor) on Feb 24, 2023 at 16:18 UTC
    $char =~ tr/ -~// and $input .= $char

    The '-' indicates a range, from ' ' to '~', which if you look at a basic ASCII chart, is all the plain printable (visible and take up one character position) characters.

    $char =~ tr/\b\x7f// is used because on my system the key labeled "Backspace" returns "\b" when running in xterm and "\x7f" when running on the Linux console. BTW, for your comment in the chatterbox, the \b in tr/\b\x7f// is an actual character "\x08" whereas the \b in a regex is a metacharacter and not an actual character.

    The code implementing the backspace is wizardry :)
    The idea is simple -> if you currently have N choices, find the longest initial substring that gives you more than N choices.
    The wizardry is the the design of regex itself, credit Larry and the implementors...
    The concept that regex finds the longest match is crucial in this program both for backspace and for advancing to the next decision point.