Finding all possible lists of X - list

I would like to create a function construct-tuples that consumes a list of length m and a Nat n and produces all possible n-tuples of a list of the elements of the consumed list. The following check-expects give an idea of what the function should produce:
(check-expect (construct-tuples '(+ -) 3)
'((+ + +) (+ + -) (+ - +) (+ - -)
(- + +) (- + -) (- - +) (- - -)))
(check-expect (construct-tuples empty 3) (list empty))
(check-expect (construct-tuples '(+ -) 0) (list empty))
(check-expect (construct-tuples '(+ - * /) 4)
(list
(list '+ '+ '+ '+)
(list '+ '+ '+ '-)
(list '+ '+ '+ '*)
(list '+ '+ '+ '/)
(list '+ '+ '- '+)
(list '+ '+ '- '-)
(list '+ '+ '- '*)
(list '+ '+ '- '/)
(list '+ '+ '* '+)
(list '+ '+ '* '-)
(list '+ '+ '* '*)
(list '+ '+ '* '/)
(list '+ '+ '/ '+)
(list '+ '+ '/ '-)
(list '+ '+ '/ '*)
(list '+ '+ '/ '/)
(list '+ '- '+ '+)
(list '+ '- '+ '-)
(list '+ '- '+ '*)
(list '+ '- '+ '/)
(list '+ '- '- '+)
(list '+ '- '- '-)
(list '+ '- '- '*)
(list '+ '- '- '/)
(list '+ '- '* '+)
(list '+ '- '* '-)
(list '+ '- '* '*)
(list '+ '- '* '/)
(list '+ '- '/ '+)
(list '+ '- '/ '-)
(list '+ '- '/ '*)
(list '+ '- '/ '/)
(list '+ '* '+ '+)
(list '+ '* '+ '-)
(list '+ '* '+ '*)
(list '+ '* '+ '/)
(list '+ '* '- '+)
(list '+ '* '- '-)
(list '+ '* '- '*)
(list '+ '* '- '/)
(list '+ '* '* '+)
(list '+ '* '* '-)
(list '+ '* '* '*)
(list '+ '* '* '/)
(list '+ '* '/ '+)
(list '+ '* '/ '-)
(list '+ '* '/ '*)
(list '+ '* '/ '/)
(list '+ '/ '+ '+)
(list '+ '/ '+ '-)
(list '+ '/ '+ '*)
(list '+ '/ '+ '/)
(list '+ '/ '- '+)
(list '+ '/ '- '-)
(list '+ '/ '- '*)
(list '+ '/ '- '/)
(list '+ '/ '* '+)
(list '+ '/ '* '-)
(list '+ '/ '* '*)
(list '+ '/ '* '/)
(list '+ '/ '/ '+)
(list '+ '/ '/ '-)
(list '+ '/ '/ '*)
(list '+ '/ '/ '/)
(list '- '+ '+ '+)
(list '- '+ '+ '-)
(list '- '+ '+ '*)
(list '- '+ '+ '/)
(list '- '+ '- '+)
(list '- '+ '- '-)
(list '- '+ '- '*)
(list '- '+ '- '/)
(list '- '+ '* '+)
(list '- '+ '* '-)
(list '- '+ '* '*)
(list '- '+ '* '/)
(list '- '+ '/ '+)
(list '- '+ '/ '-)
(list '- '+ '/ '*)
(list '- '+ '/ '/)
(list '- '- '+ '+)
(list '- '- '+ '-)
(list '- '- '+ '*)
(list '- '- '+ '/)
(list '- '- '- '+)
(list '- '- '- '-)
(list '- '- '- '*)
(list '- '- '- '/)
(list '- '- '* '+)
(list '- '- '* '-)
(list '- '- '* '*)
(list '- '- '* '/)
(list '- '- '/ '+)
(list '- '- '/ '-)
(list '- '- '/ '*)
(list '- '- '/ '/)
(list '- '* '+ '+)
(list '- '* '+ '-)
(list '- '* '+ '*)
(list '- '* '+ '/)
(list '- '* '- '+)
(list '- '* '- '-)
(list '- '* '- '*)
(list '- '* '- '/)
(list '- '* '* '+)
(list '- '* '* '-)
(list '- '* '* '*)
(list '- '* '* '/)
(list '- '* '/ '+)
(list '- '* '/ '-)
(list '- '* '/ '*)
(list '- '* '/ '/)
(list '- '/ '+ '+)
(list '- '/ '+ '-)
(list '- '/ '+ '*)
(list '- '/ '+ '/)
(list '- '/ '- '+)
(list '- '/ '- '-)
(list '- '/ '- '*)
(list '- '/ '- '/)
(list '- '/ '* '+)
(list '- '/ '* '-)
(list '- '/ '* '*)
(list '- '/ '* '/)
(list '- '/ '/ '+)
(list '- '/ '/ '-)
(list '- '/ '/ '*)
(list '- '/ '/ '/)
(list '* '+ '+ '+)
(list '* '+ '+ '-)
(list '* '+ '+ '*)
(list '* '+ '+ '/)
(list '* '+ '- '+)
(list '* '+ '- '-)
(list '* '+ '- '*)
(list '* '+ '- '/)
(list '* '+ '* '+)
(list '* '+ '* '-)
(list '* '+ '* '*)
(list '* '+ '* '/)
(list '* '+ '/ '+)
(list '* '+ '/ '-)
(list '* '+ '/ '*)
(list '* '+ '/ '/)
(list '* '- '+ '+)
(list '* '- '+ '-)
(list '* '- '+ '*)
(list '* '- '+ '/)
(list '* '- '- '+)
(list '* '- '- '-)
(list '* '- '- '*)
(list '* '- '- '/)
(list '* '- '* '+)
(list '* '- '* '-)
(list '* '- '* '*)
(list '* '- '* '/)
(list '* '- '/ '+)
(list '* '- '/ '-)
(list '* '- '/ '*)
(list '* '- '/ '/)
(list '* '* '+ '+)
(list '* '* '+ '-)
(list '* '* '+ '*)
(list '* '* '+ '/)
(list '* '* '- '+)
(list '* '* '- '-)
(list '* '* '- '*)
(list '* '* '- '/)
(list '* '* '* '+)
(list '* '* '* '-)
(list '* '* '* '*)
(list '* '* '* '/)
(list '* '* '/ '+)
(list '* '* '/ '-)
(list '* '* '/ '*)
(list '* '* '/ '/)
(list '* '/ '+ '+)
(list '* '/ '+ '-)
(list '* '/ '+ '*)
(list '* '/ '+ '/)
(list '* '/ '- '+)
(list '* '/ '- '-)
(list '* '/ '- '*)
(list '* '/ '- '/)
(list '* '/ '* '+)
(list '* '/ '* '-)
(list '* '/ '* '*)
(list '* '/ '* '/)
(list '* '/ '/ '+)
(list '* '/ '/ '-)
(list '* '/ '/ '*)
(list '* '/ '/ '/)
(list '/ '+ '+ '+)
(list '/ '+ '+ '-)
(list '/ '+ '+ '*)
(list '/ '+ '+ '/)
(list '/ '+ '- '+)
(list '/ '+ '- '-)
(list '/ '+ '- '*)
(list '/ '+ '- '/)
(list '/ '+ '* '+)
(list '/ '+ '* '-)
(list '/ '+ '* '*)
(list '/ '+ '* '/)
(list '/ '+ '/ '+)
(list '/ '+ '/ '-)
(list '/ '+ '/ '*)
(list '/ '+ '/ '/)
(list '/ '- '+ '+)
(list '/ '- '+ '-)
(list '/ '- '+ '*)
(list '/ '- '+ '/)
(list '/ '- '- '+)
(list '/ '- '- '-)
(list '/ '- '- '*)
(list '/ '- '- '/)
(list '/ '- '* '+)
(list '/ '- '* '-)
(list '/ '- '* '*)
(list '/ '- '* '/)
(list '/ '- '/ '+)
(list '/ '- '/ '-)
(list '/ '- '/ '*)
(list '/ '- '/ '/)
(list '/ '* '+ '+)
(list '/ '* '+ '-)
(list '/ '* '+ '*)
(list '/ '* '+ '/)
(list '/ '* '- '+)
(list '/ '* '- '-)
(list '/ '* '- '*)
(list '/ '* '- '/)
(list '/ '* '* '+)
(list '/ '* '* '-)
(list '/ '* '* '*)
(list '/ '* '* '/)
(list '/ '* '/ '+)
(list '/ '* '/ '-)
(list '/ '* '/ '*)
(list '/ '* '/ '/)
(list '/ '/ '+ '+)
(list '/ '/ '+ '-)
(list '/ '/ '+ '*)
(list '/ '/ '+ '/)
(list '/ '/ '- '+)
(list '/ '/ '- '-)
(list '/ '/ '- '*)
(list '/ '/ '- '/)
(list '/ '/ '* '+)
(list '/ '/ '* '-)
(list '/ '/ '* '*)
(list '/ '/ '* '/)
(list '/ '/ '/ '+)
(list '/ '/ '/ '-)
(list '/ '/ '/ '*)
(list '/ '/ '/ '/)))
I found a way to do this using recursive calls to map, but it only works for finite values, so I was wondering if there was a way to make this arbitrary?

You can indeed solve this using recursion. There's no need to even call out to functions like map. The following is an implementation that I believe solves the problem:
(define (construct-tuples symbols n)
(if (zero? n)
(list '())
(let ((tuples-n-1 (construct-tuples symbols (sub1 n))))
(for*/list ([tuple tuples-n-1]
[symbol symbols])
(cons symbol tuple)))))
This solution works via recursion. The base case returns a list containing one empty list. For each iteration, we get the list of possible tuples for n-1, and then for every symbol, create a new list, containing the original list, plus that symbol.
To illustrate how this works, consider the following:
We want to calculate (construct-tuples '(+ -) 3)
This would first need to calculate (construct-tuples '(+ -) 2)
Which would need to calculate (construct-tuples '(+ -) 1)
Which would need to calculate (construct-tuples '(+ -) 0)
... the answer of which is (list '())
For each symbol in '(+ -) we create a new list appending that symbol to '(). This returns (list '(+) '(-))
For each symbol in '(+ -), create a new list appending that symbol to each list in (list '(+) '(-)). This will create 4 new lists (2x2). (list '(+ +) '(+ -) '(- +) '(- -))
Lastly, for each symbol in '(+ -), create a new list for each of the lists that we got from the recursive iteration (8 lists will be created (4x2))
Thes for*/list function does a lot of the heavy lifting in this function. What this does is iterates for every possible combination of the various arguments producing a list of the various answers.
(for*/list ([x '(+ -)]
[y '(* /)])
(list x y))
This will produce a list of every possible tuple between '(x -) and '(* /)

Related

Perl regex for a character NOT within string characters

I am writing a perl script that 'compiles' shell code. One thing I need to do is detect ; characters and deal with them (things like multiple commands on one line), but only when they are not escaped (by \ ), or within a string. For example, we shouldn't match 'some ; text ;' , but we should match the semicolons in between the two echo statements in echo ";ignore; inside ;" ; echo 'something;' \; 'else';
In the above example, exactly TWO semicolons should have been matched.
I have tried this with a regex loop
while ($_ =~ /('[^']+')*?("[^"]+")*?(?<!\\)(?<match>;)/g)
{
print "semiolon: $+{match}\n";
# process the match . . .
}
Whilst this works for some examples, there are some cases where it doesn't properly detect the semicolon is 'inside' two strings; as it can't match a PAIR of them before the current match. How would I go about ensuring that we only match semicolons outside a string?
Thanks in advance.
I agree with the other commenters that there are much better ways to develop a parser like this.
Nevertheless, I want to suggest two proposals:
while(/\G((?:[^;'"\\]++|'[^']*+'|"[^"]*+"|\\.)*;)/gx){
print " command: $1\n";
# process the match . . .
}
\G is a zero-width assertion that matches the position where the previous m//g left off, see perlop#\G-assertion. (In the docs there is also an example of a lex-like scanner that might be of interest.)
The non-capturing group contains harmless chars, quoted strings, and escaped characters
Note the use of possessive quantifiers in order to avoid performance issues due to backtracing.
i removed the negative assertion (?<!\\), because this would fail in cases such as echo \\;
This code will work with your given examples. However, e.g. bash allows escaping double-quotes inside of double-quoted string such as echo "\"".
If your shell should accept such a code, too, then the regexp has to be expanded:
while(/\G( # anchor for beginning
(?:[^;'"\\]++ # harmless chars
|'[^']*+' # or single-quoted string
|"(?: # or double-quoted string,
[^"\\]++ # containing harmless chars
|\\. # or an escaped char
)*+" # with arbitrary many repetitions
|\\. # or an escaped char
)*+ # with arbitrary many repetitions
;) # end with semi-colon
/gx){
print " command: $1\n";
# process the match . . .
}
Such pure regexp solutions are very error-prone. And the more exceptions you find that have to be treated, the more complicated the pattern get and the more difficult it gets to debug that code.
some tests:
use strict;
use warnings;
use Test::More tests => 16;
my $samples = [
{"'some ; text ;'" => []},
{'echo;' => ['echo;']},
{'echo ";ignore; inside ;" ; echo \'something;\' \; \'else\';' => [
'echo ";ignore; inside ;" ;', ' echo \'something;\' \; \'else\';']},
{'echo moep; echo moep;' => [ 'echo moep;', ' echo moep;']},
{'echo \a ; echo moep;' => [ 'echo \a ;', ' echo moep;']},
{'echo \\a ; echo moep;' => [ 'echo \\a ;', ' echo moep;']},
{'echo \\\a ; echo moep;' => [ 'echo \\\a ;', ' echo moep;']},
{'echo \; echo moep;' => [ 'echo \; echo moep;']},
{'echo \\; echo moep;' => [ 'echo \; echo moep;']}, # '\\;' eq '\;' !
{'echo \\\; echo moep;' => [ 'echo \\\;', ' echo moep;']},
{'echo ";\';\';"; echo moep;' => [ 'echo ";\';\';";', ' echo moep;']},
{'echo "\";"; echo moep;' => [ 'echo "\";";', ' echo moep;']},
{'echo ";\""; echo moep;' => [ 'echo ";\"";', ' echo moep;']},
{'echo "\";\""; echo moep;' => [ 'echo "\";\"";', ' echo moep;']},
{'echo ";\\\\"; echo moep;' => [ 'echo ";\\\\";', ' echo moep;']},
{'echo "\\\\\";\""; echo moep;' => [ 'echo "\\\\\";\"";', ' echo moep;']},
];
for my $sample(#$samples){
while(my ($line, $test) = each %$sample){
my #result = $line =~ /\G((?:[^;'"\\]++|'[^']*+'|"(?:[^"\\]++|\\.)*+"|\\.)*+;)/g;
is_deeply(\#result, $test, $line);
}
}
Still, you can easily find many false positive/negative samples. For example I did not cope with parentheses. This would make the above pattern much more complicated by using recursive subpatterns.

bash: translate a string to replace combination of 'character+whitespace' with comma

I am trying to translate(tr) a string to replace combination of two characters with comma.
string:-
input is "test-1 - test-2 - test-3"
desired output is "test-1 ,test-2 ,test-3"
To achieve this I need to replace " -" [space + '-'] with comma [,]
I tried the below options
$ echo "test-1 - test-2 - test-3" | tr '-[:space:]' ','
$ echo "test-1 - test-2 - test-3" | tr '- ' ','
but throwing an error?, it works for a combination of any other two charachters but not with space?
You can use sed instead of tr to achieve this:
$ echo "test-1 - test-2 - test-3" | sed "s/ - / ,/g"

Replace a double backslash followed by quote (\\') using sed?

I am unable to replace double backslash followed by quote \\' in sed. This is my current command
echo file.txt | sed "s:\\\\':\\':g"
The above command not only replaces \\' with \' it also replaces \' with '
How could I just replace exact match?
Input:
'one', 'two \\'change', 'three \'unchanged'
Expected:
'one', 'two \'change', 'three \'unchanged'
Actual:
'one', 'two \'change', 'three 'unchanged'
$ sed "s/\\\\\\\'/\\\'/g" file
'one', 'two \'change', 'three \'unchanged'
Here is a discussion on why sed needs 3 backslashes for one
You can also use:
sed "s/\\\\\'/\\\'/g"

Replacing escaped string with another escaped string with sed

I have .bashrc file and in the file this line appears:
PS1='${debian_chroot:+($debian_chroot)}\[\033[01;32m\]\u#\h\[\033[00m\]:\[\033[01;34m\]\w\[\033[00m\]\$ '
And I'm trying to replace it with this:
PS1='\[\e[32m\]\A\[\e[m\] \[\e[31m\]\u\[\e[m\]#\[\e[36m\]\h\[\e[m\]\[\e[32m\]:\[\e[m\]\[\e[32m\]\w\[\e[m\]\\$ '
I tried to do this with:
sed "s#PS1='\$\{debian_chroot:\+\(\$debian_chroot\)\}\\\[\\033\[01;32m\\\]\\u#\\h\\\[\\033\[00m\\\]:\\\[\\033\[01;34m\\\]\\w\\\[\\033\[00m\\\]\\\$ '#PS1='\\\[\\e[32m\\\]\\A\\\[\\e\[m\\\] \\\[\\e\[31m\\\]\\u\\\[\\e\[m\\\]#\\\[\\e\[36m\\\]\\h\\\[\\e\[m\\\]\\\[\\e\[32m\\\]:\\\[\\e\[m\\\]\\\[\\e\[32m\\\]\\w\\\[\\e\[m\\\]\\\\\$ '#g" .bashrc
But I got error saying:
sed: -e expression #1, char 267: Invalid content \{\}
I'd use sed or any other bash/dash scripting way so I can make me a customization script for systems that I regularly use.
Thank you for help.
What I would do instead of weird ANSI codes :
PURPLE=$(tput setaf 5)
RED=$(tput setaf 1)
WHITE=$(tput setaf 7)
GREEN=$(tput setaf 2)
YELLOW=$(tput setaf 3)
CYAN=$(tput setaf 4)
LIGHT_CYAN=$(tput setaf 6)
STOP=$(tput sgr0)
PS1="\[$PURPLE\]\u\[$WHITE\]#\[$GREEN\]\h\[$WHITE\]:\[$GREEN\]\w\[$WHITE\] $ \[$STOP\]"
Finally to make a full reply to all the aspect of the question, :
sed -i '/^PS1=/d' ~/.bashrc # remove PS1 line in bashrc
# now feeding bashrc with goodies :
cat<<'EOF'>>~/.bashrc
PURPLE=$(tput setaf 5)
RED=$(tput setaf 1)
WHITE=$(tput setaf 7)
GREEN=$(tput setaf 2)
YELLOW=$(tput setaf 3)
CYAN=$(tput setaf 4)
LIGHT_CYAN=$(tput setaf 6)
STOP=$(tput sgr0)
PS1="\[$PURPLE\]\u\[$WHITE\]#\[$GREEN\]\h\[$WHITE\]:\[$GREEN\]\w\[$WHITE\] $ \[$STOP\]"
EOF
This might work for you (GNU sed):
sed 's|PS1='\''${debian_chroot:+($debian_chroot)}\\\[\\033\[01;32m\\\]\\u#\\h\\\[\\033\[00m\\\]:\\\[\\033\[01;34m\\\]\\w\\\[\\033\[00m\\\]\\$ '\''|PS1='^''\\[\\e[32m\\]\\A\[\\e[m\\] \\[\\e[31m\\]\\u\\[\\e[m\\]#\\[\\e[36m\\]\\h\\[\\e[m\\]\\[\\e[32m\\]:\\[\\e[m\\]\\[\\e[32m\\]\\w\\[\\e[m\\]\\\\$ '\''|' file
Replace ' by '\'' and \ by \\ in both the pattern and replacement and [] by \[\] in the pattern only.

using awk in tcl script

I want to print a particular column number fields in a file while in TCL script.
I tried with exec awk '{print $4}' foo where foo is filename, but it is not working as it gives error
can't read "4": no such variable
How can I do above awk in tcl scripting?
Thanks,
The problem is that single quotes have no special meaning in Tcl, they're just ordinary characters in a string. Thus the $4 is not hidden from Tcl and it tries to expand the variable.
The Tcl equivalent to shell single quotes are braces. This is what you need:
exec awk {{print $4}} foo
The double braces look funny, but the outer pair are for Tcl and the inner pair are for awk.
Btw, the Tcl translation of that awk program is:
set fid [open foo r]
while {[gets $fid line] != -1} {
set fields [regexp -all -inline {\S+} $line]
puts [lindex $fields 3]
}
close $fid