[User]
Given a List (abstract data type) of integer values, find all its maximal-length non-increasing subsequences. Categorize each of these subsequences by its percentage change using the following groups:

* Greater than 0% and less than 4%
* Greater than or equal to 4% and less than 8%
* Greater than or equal to 8% and less than 12%
* Greater than or equal to 12% and less than 16%
* Greater than or equal to 16% and less than 25%
* Greater than or equal to 25%

If we were to plot these values, we'd be looking for peaks and troughs, categorized by the difference between the local maximum and the local minimum, as a percentage of the local maximum.

A plot highlighting decreasing contiguous subsequences

Using the following example sequence, display the count of subsequences per group.

```
90, 90, 90, 91, 91, 92, 92, 92, 91, 91, 91, 90, 90, 90, 89, 89, 88, 87, 87, 87, 86, 86, 86, 85, 85,
86, 86, 87, 87, 88, 89, 89, 89, 90, 90, 91, 91, 91, 92, 92, 92, 92, 92, 92, 92, 92, 92, 91, 91, 90,
90, 90, 90, 90, 89, 89, 89, 89, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 89, 89, 89, 89, 89,
89, 90, 90, 90, 89, 89, 89, 89, 89, 89, 88, 88, 88, 88, 88, 88, 87, 88, 88, 88, 88, 88, 88, 88, 88,
88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 89, 89, 89, 89, 89, 88, 88, 88, 88, 88, 88, 89,
89, 89, 89, 89, 89, 89, 89, 88, 88, 88, 88, 88, 88, 88, 88, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87,
87, 87, 88, 88, 88, 88, 88, 88, 88, 88, 88, 89, 89, 89, 89, 89, 89, 89, 88, 88, 88, 88, 88, 88, 88,
88, 88, 88, 88, 89, 89, 89, 89, 89, 89, 89, 89, 89, 89, 88, 88, 88, 87, 87, 87, 87, 86, 86, 86, 86,
86, 86, 87, 87, 87, 87, 87, 87, 87, 88, 88, 88, 88, 88, 88, 88, 88, 88, 89, 89, 89, 89, 89, 89, 89,
88, 88, 88, 88, 88, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 89, 89, 91,
94, 94, 95, 96, 96, 96, 97, 97, 96, 96, 96, 96, 95, 95, 94, 93, 93, 92, 92, 91, 91, 90, 89, 89, 88,
86, 86, 85, 83, 83, 81, 80, 80, 80, 79, 79, 79, 78, 78, 79, 81, 82, 82, 85, 89, 89, 91, 93, 93, 94,
95, 95, 95, 95, 95, 95, 95, 95, 95, 94, 94, 94, 94, 93, 93, 93, 92, 92, 91, 91, 91, 90, 90, 90, 88,
87, 87, 86, 85, 85, 84, 84, 84, 83, 84, 84, 84, 85, 86, 86, 87, 87, 87, 88, 88, 88, 89, 90, 90, 90,
91, 91, 92, 92, 92, 93, 94, 94, 94, 95, 95, 95, 95, 94, 94, 94, 93, 93, 93, 92, 92, 92, 91, 91, 90,
89, 89, 87, 86, 85, 85, 84, 83, 83, 82, 82, 82, 81, 81, 81, 81, 81, 81, 82, 85, 85, 86, 89, 89, 91,
92, 93, 93, 93, 94, 94, 94, 94, 94, 94, 94, 94, 94, 93, 93, 93, 92, 92, 92, 91, 91, 91, 90, 89, 89,
88, 88, 88, 87, 87, 87, 86, 86, 86, 85, 85, 85, 85, 85, 85, 86, 87, 87, 87, 88, 88, 88, 88, 88, 88,
89, 89, 89, 89, 89, 89, 90, 90, 90, 90, 91, 91, 92, 93, 93, 94, 94, 95, 95, 95, 96, 96, 96, 95, 95,
95, 94, 94, 93, 93, 93, 92, 90, 90, 89, 87, 87, 87, 85, 83, 83, 82, 81, 81, 81, 80, 80, 81, 81, 81,
81, 81, 81, 81, 81, 81, 81, 81, 81, 83, 86, 88, 88, 90, 91, 91, 91, 92, 92, 93, 93, 93, 94, 95, 95,
95, 96, 96, 96, 96, 96, 96, 96, 95, 95, 95, 95, 95, 94, 93, 93, 92, 92, 92, 91, 90, 90, 90, 90, 90,
91, 93, 93, 94, 94, 94, 94, 95, 94, 94, 94, 94, 94, 94, 93, 93, 93, 93, 93, 93, 92, 92, 92, 92, 92,
91, 91, 91, 91, 91, 91, 91, 91, 90, 90, 90, 90, 90, 90, 90, 90, 89, 89, 89, 89, 89, 89, 89, 89, 89,
89, 90, 90, 90, 90, 91, 91, 92, 93, 93, 93, 94, 94, 94, 94, 94, 94, 94, 94, 94, 95, 95, 95, 95, 95,
95, 95, 95, 95, 94, 93, 93, 93, 93, 93, 92, 92, 92, 91, 91, 91, 91, 90, 90, 90, 89, 89, 89, 88, 88,
88, 88, 88, 88, 88, 88, 88, 89, 89, 89, 89, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 91, 91, 91, 91,
91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 91, 92,
92, 93, 93, 93, 93, 94, 94, 94, 93, 93, 93, 93, 93, 93, 92, 92, 92, 91, 91, 91, 90, 90, 90, 89, 88,
88, 87, 87, 87, 86, 86, 85, 85, 85, 86, 86, 86, 87, 87, 88, 88, 88, 89, 90, 90, 90, 91, 91, 91, 91,
91, 91, 91, 91, 91, 92, 92, 92, 93, 93, 93, 93, 93, 93, 93, 92, 92, 92, 91, 91, 90, 90, 90, 89, 88,
87, 87, 87, 86, 86, 86, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 86, 86, 86, 86, 87, 88, 88, 88,
89, 89, 90, 91, 91, 92, 93, 93, 93, 94, 94, 94, 94, 94, 94, 94, 94, 94, 93, 93, 93, 92, 92, 92, 91,
90, 90, 90, 89, 89, 88, 88, 88, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 88, 88, 88,
90, 90, 91, 93, 93, 93, 93, 93, 94, 93, 93, 93, 93, 93, 93, 92, 92, 92, 91, 91, 91, 90, 90, 90, 89,
89, 89, 88, 87, 87, 87, 87, 87, 86, 87, 87, 87, 87, 87, 87, 87, 87, 87, 88, 88, 88, 88, 88, 88, 88,
89

```

It's OK to hard code the example sequence or read it from a file. Plotting decreasing subsequences is optional.

[Assistant]
Since these are percentages, no need to specify a span. The span is automatically 0-100. The carat in the bin ranges mean "upto, but not including".

```
my @values =
90, 90, 90, 91, 91, 92, 92, 92, 91, 91, 91, 90, 90, 90, 89, 89, 88, 87, 87, 87, 86, 86, 86, 85, 85,
86, 86, 87, 87, 88, 89, 89, 89, 90, 90, 91, 91, 91, 92, 92, 92, 92, 92, 92, 92, 92, 92, 91, 91, 90,
90, 90, 90, 90, 89, 89, 89, 89, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 89, 89, 89, 89, 89,
89, 90, 90, 90, 89, 89, 89, 89, 89, 89, 88, 88, 88, 88, 88, 88, 87, 88, 88, 88, 88, 88, 88, 88, 88,
88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 88, 89, 89, 89, 89, 89, 88, 88, 88, 88, 88, 88, 89,
89, 89, 89, 89, 89, 89, 89, 88, 88, 88, 88, 88, 88, 88, 88, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87,
87, 87, 88, 88, 88, 88, 88, 88, 88, 88, 88, 89, 89, 89, 89, 89, 89, 89, 88, 88, 88, 88, 88, 88, 88,
88, 88, 88, 88, 89, 89, 89, 89, 89, 89, 89, 89, 89, 89, 88, 88, 88, 87, 87, 87, 87, 86, 86, 86, 86,
86, 86, 87, 87, 87, 87, 87, 87, 87, 88, 88, 88, 88, 88, 88, 88, 88, 88, 89, 89, 89, 89, 89, 89, 89,
88, 88, 88, 88, 88, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 89, 89, 91,
94, 94, 95, 96, 96, 96, 97, 97, 96, 96, 96, 96, 95, 95, 94, 93, 93, 92, 92, 91, 91, 90, 89, 89, 88,
86, 86, 85, 83, 83, 81, 80, 80, 80, 79, 79, 79, 78, 78, 79, 81, 82, 82, 85, 89, 89, 91, 93, 93, 94,
95, 95, 95, 95, 95, 95, 95, 95, 95, 94, 94, 94, 94, 93, 93, 93, 92, 92, 91, 91, 91, 90, 90, 90, 88,
87, 87, 86, 85, 85, 84, 84, 84, 83, 84, 84, 84, 85, 86, 86, 87, 87, 87, 88, 88, 88, 89, 90, 90, 90,
91, 91, 92, 92, 92, 93, 94, 94, 94, 95, 95, 95, 95, 94, 94, 94, 93, 93, 93, 92, 92, 92, 91, 91, 90,
89, 89, 87, 86, 85, 85, 84, 83, 83, 82, 82, 82, 81, 81, 81, 81, 81, 81, 82, 85, 85, 86, 89, 89, 91,
92, 93, 93, 93, 94, 94, 94, 94, 94, 94, 94, 94, 94, 93, 93, 93, 92, 92, 92, 91, 91, 91, 90, 89, 89,
88, 88, 88, 87, 87, 87, 86, 86, 86, 85, 85, 85, 85, 85, 85, 86, 87, 87, 87, 88, 88, 88, 88, 88, 88,
89, 89, 89, 89, 89, 89, 90, 90, 90, 90, 91, 91, 92, 93, 93, 94, 94, 95, 95, 95, 96, 96, 96, 95, 95,
95, 94, 94, 93, 93, 93, 92, 90, 90, 89, 87, 87, 87, 85, 83, 83, 82, 81, 81, 81, 80, 80, 81, 81, 81,
81, 81, 81, 81, 81, 81, 81, 81, 81, 83, 86, 88, 88, 90, 91, 91, 91, 92, 92, 93, 93, 93, 94, 95, 95,
95, 96, 96, 96, 96, 96, 96, 96, 95, 95, 95, 95, 95, 94, 93, 93, 92, 92, 92, 91, 90, 90, 90, 90, 90,
91, 93, 93, 94, 94, 94, 94, 95, 94, 94, 94, 94, 94, 94, 93, 93, 93, 93, 93, 93, 92, 92, 92, 92, 92,
91, 91, 91, 91, 91, 91, 91, 91, 90, 90, 90, 90, 90, 90, 90, 90, 89, 89, 89, 89, 89, 89, 89, 89, 89,
89, 90, 90, 90, 90, 91, 91, 92, 93, 93, 93, 94, 94, 94, 94, 94, 94, 94, 94, 94, 95, 95, 95, 95, 95,
95, 95, 95, 95, 94, 93, 93, 93, 93, 93, 92, 92, 92, 91, 91, 91, 91, 90, 90, 90, 89, 89, 89, 88, 88,
88, 88, 88, 88, 88, 88, 88, 89, 89, 89, 89, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 91, 91, 91, 91,
91, 91, 91, 91, 91, 91, 91, 91, 91, 91, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 90, 91, 92,
92, 93, 93, 93, 93, 94, 94, 94, 93, 93, 93, 93, 93, 93, 92, 92, 92, 91, 91, 91, 90, 90, 90, 89, 88,
88, 87, 87, 87, 86, 86, 85, 85, 85, 86, 86, 86, 87, 87, 88, 88, 88, 89, 90, 90, 90, 91, 91, 91, 91,
91, 91, 91, 91, 91, 92, 92, 92, 93, 93, 93, 93, 93, 93, 93, 92, 92, 92, 91, 91, 90, 90, 90, 89, 88,
87, 87, 87, 86, 86, 86, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 86, 86, 86, 86, 87, 88, 88, 88,
89, 89, 90, 91, 91, 92, 93, 93, 93, 94, 94, 94, 94, 94, 94, 94, 94, 94, 93, 93, 93, 92, 92, 92, 91,
90, 90, 90, 89, 89, 88, 88, 88, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 87, 88, 88, 88,
90, 90, 91, 93, 93, 93, 93, 93, 94, 93, 93, 93, 93, 93, 93, 92, 92, 92, 91, 91, 91, 90, 90, 90, 89,
89, 89, 88, 87, 87, 87, 87, 87, 86, 87, 87, 87, 87, 87, 87, 87, 87, 87, 88, 88, 88, 88, 88, 88, 88,
89;

my @bins = 0^..^4, 4..^8, 8..^12, 12..^16, 16..^25, 25..100;

my @subseqs;

@values.map: {
    state $last = $_;
    state $incr = 0;
    ++$incr if $_ > $last;
    @subseqs[$incr].push: $_;
    $last = $_;
};

sub bin (@items, @bins, :&as) {
    my @classified;
    for @items {
        my $value = .&as;
        for @bins {
            state $index = 0;
            @classified[$index]++ if $value ∈ $_;
            ++$index;
        }
    }
    @classified
}

say "{.[0].gist}% : {.[1]}" for @bins Z flat @subseqs.&bin(@bins, :as{[R-] .minmax.bounds}), 0 xx *;

```

Output:

```
0^..^4% : 7
4..^8% : 6
8..^12% : 4
12..^16% : 2
16..^25% : 2
25..100% : 0
```


[User]
Task

Demonstrate how to copy data structures containing complex heterogeneous and cyclic semantics.

This is often referred to as deep copying, and is normally required where structures are mutable and to ensure that independent copies can be manipulated without side-effects.

If this facility is not built into the language, it is permissible to use functions from a common library, or a coded procedure.

The task should show:

* Relevant semantics of structures, such as their homogeneous or heterogeneous properties, or containment of (self- or mutual-reference) cycles.

* Any limitations of the method.

* That the structure and its copy are different.

* Suitable links to external documentation for common libraries.

[Assistant]
(formerly Perl 6)

Raku doesn't currently provide a proper mechanism for deep copies, but depending on your requirements you could use one of these work-arounds:

**1) Use `.deepmap(*.clone)`:**

.deepmap constructs a copy of the data structure, and .clone makes a shallow copy of each leaf node. Limitations:

* Hangs indefinitely when given a self-referential data structure.
* Descends only into Iterable collections (like Array/Hash), which means that a Pair or a typical custom object would be considered a leaf node.

```
my %x = foo => 0, bar => [0, 1];
my %y = %x.deepmap(*.clone);

%x<bar>[1]++;
say %x;
say %y;

```

Output:

```
{bar => [0 2], foo => 0}
{bar => [0 1], foo => 0}

```

**2) Use `.raku.EVAL`:**

.raku serializes the data structure to Raku code, and .EVAL deserializes it. Limitations:

* Doesn't work correctly if the data structure contains elements that can't be properly serialized, such as closures or file handles.

```
my %x = foo => 0, bar => [0, 1];
my %y = %x.raku.EVAL;

%x<bar>[1]++;
say %x;
say %y;

```

Output:

```
{bar => [0 2], foo => 0}
{bar => [0 1], foo => 0}

```


[User] Demonstrate how to define a type that behaves like an integer but has a lowest valid value of 1 and a highest valid value of 10. Include all bounds checking you need to write, or explain how the compiler or interpreter creates those bounds checks for you.

[Assistant]
(formerly Perl 6)

```
subset OneToTen of Int where 1..10;

my OneToTen $n = 5;
$n += 6;

```

Here the result 11 fails to smartmatch against the range `1..10`, so the second assignment throws an exception. You may use any valid smartmatch predicate within a `where` clause, so the following one-argument closure is also legal:

```
subset Prime of Int where -> $n { $n > 1 and so $n %% none 2 .. $n.sqrt }

```


[User]
A delegate is a helper object used by another object. The delegator may send the delegate certain messages, and provide a default implementation when there is no delegate or the delegate does not respond to a message. This pattern is heavily used in Cocoa framework on Mac OS X. See also wp:Delegation pattern.

Objects responsibilities:

Delegator:

* Keep an optional delegate instance.
* Implement "operation" method, returning the delegate "thing" if the delegate respond to "thing", or the string "default implementation".

Delegate:

* Implement "thing" and return the string "delegate implementation"

Show how objects are created and used. First, without a delegate, then with a delegate that does not implement "thing", and last with a delegate that implements "thing".

[Assistant]
(formerly Perl 6)

```
class Non-Delegate  { }

class Delegate {
	method thing {
		return "delegate implementation"
	}
}

class Delegator {
	has $.delegate is rw;

	method operation {
		$.delegate.^can( 'thing' ) ?? $.delegate.thing
		!! "default implementation"
	}
}

my Delegator $d .= new;

say "empty: "~$d.operation;

$d.delegate = Non-Delegate.new;

say "Non-Delegate: "~$d.operation;

$d.delegate = Delegate.new;

say "Delegate: "~$d.operation;

```


[User]
Task

Delete a file called "input.txt" and delete a directory called "docs".

This should be done twice: once "here", i.e. in the current working directory and once in the filesystem root.

[Assistant]
(formerly Perl 6)

```
unlink 'input.txt';
unlink '/input.txt';
rmdir 'docs';
rmdir '/docs';

```


[User]
W Edwards Deming was an American statistician and management guru who used physical demonstrations to illuminate his teachings. In one demonstration Deming repeatedly dropped marbles through a funnel at a target, marking where they landed, and observing the resulting pattern. He applied a sequence of "rules" to try to improve performance. In each case the experiment begins with the funnel positioned directly over the target.

* **Rule 1**: The funnel remains directly above the target.
* **Rule 2**: Adjust the funnel position by shifting the target to compensate after each drop. E.g. If the last drop missed 1 cm east, move the funnel 1 cm to the west of its current position.
* **Rule 3**: As rule 2, but first move the funnel back over the target, before making the adjustment. E.g. If the funnel is 2 cm north, and the marble lands 3 cm north, move the funnel 3 cm south of the target.
* **Rule 4**: The funnel is moved directly over the last place a marble landed.

Apply the four rules to the set of 50 pseudorandom displacements provided (e.g in the Racket solution) for the dxs and dys. **Output**: calculate the mean and standard-deviations of the resulting x and y values for each rule.

Note that rules 2, 3, and 4 give successively worse results. Trying to deterministically compensate for a random process is counter-productive, but -- according to Deming -- quite a popular pastime: see the Further Information, below for examples.

**Stretch goal 1**: Generate fresh pseudorandom data. The radial displacement of the drop from the funnel position is given by a Gaussian distribution (standard deviation is 1.0) and the angle of displacement is uniformly distributed.

**Stretch goal 2**: Show scatter plots of all four results.

Further information

* Further explanation and interpretation
* Video demonstration of the funnel experiment at the Mayo Clinic.

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.10

```
sub mean { @_ R/ [+] @_ }
sub stddev {
    # <(x - <x>)²> = <x²> - <x>²
    sqrt( mean(@_ »**» 2) - mean(@_)**2 )
}

constant @dz = <
    -0.533  0.270  0.859 -0.043 -0.205 -0.127 -0.071  0.275
     1.251 -0.231 -0.401  0.269  0.491  0.951  1.150  0.001
    -0.382  0.161  0.915  2.080 -2.337  0.034 -0.126  0.014
     0.709  0.129 -1.093 -0.483 -1.193  0.020 -0.051  0.047
    -0.095  0.695  0.340 -0.182  0.287  0.213 -0.423 -0.021
    -0.134  1.798  0.021 -1.099 -0.361  1.636 -1.134  1.315
     0.201  0.034  0.097 -0.170  0.054 -0.553 -0.024 -0.181
    -0.700 -0.361 -0.789  0.279 -0.174 -0.009 -0.323 -0.658
     0.348 -0.528  0.881  0.021 -0.853  0.157  0.648  1.774
    -1.043  0.051  0.021  0.247 -0.310  0.171  0.000  0.106
     0.024 -0.386  0.962  0.765 -0.125 -0.289  0.521  0.017
     0.281 -0.749 -0.149 -2.436 -0.909  0.394 -0.113 -0.598
     0.443 -0.521 -0.799  0.087
> Z+ (1i X* <
     0.136  0.717  0.459 -0.225  1.392  0.385  0.121 -0.395
     0.490 -0.682 -0.065  0.242 -0.288  0.658  0.459  0.000
     0.426  0.205 -0.765 -2.188 -0.742 -0.010  0.089  0.208
     0.585  0.633 -0.444 -0.351 -1.087  0.199  0.701  0.096
    -0.025 -0.868  1.051  0.157  0.216  0.162  0.249 -0.007
     0.009  0.508 -0.790  0.723  0.881 -0.508  0.393 -0.226
     0.710  0.038 -0.217  0.831  0.480  0.407  0.447 -0.295
     1.126  0.380  0.549 -0.445 -0.046  0.428 -0.074  0.217
    -0.822  0.491  1.347 -0.141  1.230 -0.044  0.079  0.219
     0.698  0.275  0.056  0.031  0.421  0.064  0.721  0.104
    -0.729  0.650 -1.103  0.154 -1.720  0.051 -0.385  0.477
     1.537 -0.901  0.939 -0.411  0.341 -0.411  0.106  0.224
    -0.947 -1.424 -0.542 -1.032
>);

constant @rule =
-> \z, \dz { 0 },
-> \z, \dz { -dz },
-> \z, \dz { -z - dz },
-> \z, \dz {  z + dz },
;

for @rule {
    say "Rule $(++$):";
    my $target = 0i;
    my @z = gather for @dz -> $dz {
	take $target + $dz;
	$target = .($target, $dz)
    }
    printf "Mean    x, y   : %7.4f %7.4f\n",   mean(@z».re),   mean(@z».im);
    printf "Std dev x, y   : %7.4f %7.4f\n", stddev(@z».re), stddev(@z».im);
}

```

Output:

```
Rule 1:
Mean    x, y   :  0.0004  0.0702
Std dev x, y   :  0.7153  0.6462
Rule 2:
Mean    x, y   :  0.0009 -0.0103
Std dev x, y   :  1.0371  0.8999
Rule 3:
Mean    x, y   :  0.0439 -0.0063
Std dev x, y   :  7.9871  4.7784
Rule 4:
Mean    x, y   :  3.1341  5.4210
Std dev x, y   :  1.5874  3.9304
```


[User]
There is a highly organized city that has decided to assign a number to each of their departments:

:   :   * police department
        * sanitation department
        * fire department

Each department can have a number between   **1**   and   **7**   (inclusive).

The three department numbers are to be unique (different from each other) and must add up to   **12**.

The Chief of the Police doesn't like odd numbers and wants to have an even number for his department.

Task

Write a computer program which outputs all valid combinations.

Possible output   (for the 1st and 14th solutions):

```
 --police--  --sanitation--  --fire--
     2             3            7
     6             5            1

```

[Assistant]
(formerly Perl 6)

```
for (1..7).combinations(3).grep(*.sum == 12) {
    for   .permutations\  .grep(*.[0] %%  2) {
        say <police fire sanitation> Z=> .list;
    }
}

```

Output:

```
(police => 4 fire => 1 sanitation => 7)
(police => 4 fire => 7 sanitation => 1)
(police => 6 fire => 1 sanitation => 5)
(police => 6 fire => 5 sanitation => 1)
(police => 2 fire => 3 sanitation => 7)
(police => 2 fire => 7 sanitation => 3)
(police => 2 fire => 4 sanitation => 6)
(police => 2 fire => 6 sanitation => 4)
(police => 4 fire => 2 sanitation => 6)
(police => 4 fire => 6 sanitation => 2)
(police => 6 fire => 2 sanitation => 4)
(police => 6 fire => 4 sanitation => 2)
(police => 4 fire => 3 sanitation => 5)
(police => 4 fire => 5 sanitation => 3)

```


[User]
Generate and show all primes with strictly descending decimal digits.

See also

* OEIS:A052014 - Primes with distinct digits in descending order

Related

* Ascending primes

[Assistant]
Trivial variation of Ascending primes task.

```
put (flat 2, 3, 5, 7, sort +*, gather (3..9).map: &recurse ).batch(10)».fmt("%8d").join: "\n";

sub recurse ($str) {
    .take for ($str X~ (1, 3, 7)).grep: { .is-prime && [>] .comb };
    recurse $str × 10 + $_ for 2 ..^ $str % 10;
}

```

Output:

```
       2        3        5        7       31       41       43       53       61       71
      73       83       97      421      431      521      541      631      641      643
     653      743      751      761      821      853      863      941      953      971
     983     5431     6421     6521     7321     7541     7621     7643     8431     8521
    8543     8641     8731     8741     8753     8761     9421     9431     9521     9631
    9643     9721     9743     9851     9871    75431    76421    76541    76543    86531
   87421    87541    87631    87641    87643    94321    96431    97651    98321    98543
   98621    98641    98731   764321   865321   876431   975421   986543   987541   987631
 8764321  8765321  9754321  9875321 97654321 98764321 98765431
```


[User]
Task

Write a function to detect a   *divide by zero error*   without checking if the denominator is zero.

[Assistant]
(formerly Perl 6)

#### Try/Catch

```
sub div($a, $b) {
    my $r;
    try {
        $r = $a / $b;
        CATCH {
            default { note "Unexpected exception, $_" }
        }
    }
    return $r // Nil;
}
say div(10,2);
say div(1, sin(0));

```

Output:

```
5
Unexpected exception, Attempt to divide 1 by zero using /
Nil
```

#### Multi Method Dispatch

```
multi div($a, $b) { return $a / $b }
multi div($a, $b where { $b == 0 }) { note 'Attempt to divide by zero.'; return Nil }

say div(10, 2);
say div(1, sin(0));

```

Output:

```
5
Attempt to divide by zero.
Nil
```


[User]
For a given matrix, return the determinant and the permanent of the matrix.

The determinant is given by

:   :   det
        (
        A
        )
        =

        ∑

        σ
        sgn

        (
        σ
        )

        ∏

        i
        =
        1

        n

        M

        i
        ,

        σ

        i
        {\displaystyle {\displaystyle \det(A)=\sum \_{\sigma }\operatorname {sgn}(\sigma )\prod \_{i=1}^{n}M\_{i,\sigma \_{i}}}}

while the permanent is given by

:   :   perm

        (
        A
        )
        =

        ∑

        σ

        ∏

        i
        =
        1

        n

        M

        i
        ,

        σ

        i
        {\displaystyle {\displaystyle \operatorname {perm} (A)=\sum \_{\sigma }\prod \_{i=1}^{n}M\_{i,\sigma \_{i}}}}

In both cases the sum is over the permutations

σ
{\displaystyle {\displaystyle \sigma }}
 of the permutations of 1, 2, ..., *n*. (A permutation's sign is 1 if there are an even number of inversions and -1 otherwise; see parity of a permutation.)

More efficient algorithms for the determinant are known: LU decomposition, see for example wp:LU decomposition#Computing the determinant. Efficient methods for calculating the permanent are not known.

Related task

* Permutations by swapping

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2015.12

Uses the permutations generator from the Permutations by swapping task. This implementation is naive and brute-force (slow) but exact.

```
sub insert ($x, @xs) { ([flat @xs[0 ..^ $_], $x, @xs[$_ .. *]] for 0 .. @xs) }
sub order ($sg, @xs) { $sg > 0 ?? @xs !! @xs.reverse }

multi σ_permutations ([]) { [] => 1 }

multi σ_permutations ([$x, *@xs]) {
    σ_permutations(@xs).map({ |order($_.value, insert($x, $_.key)) }) Z=> |(1,-1) xx *
}

sub m_arith ( @a, $op ) {
    note "Not a square matrix" and return
      if [||] map { @a.elems cmp @a[$_].elems }, ^@a;
    sum σ_permutations([^@a]).race.map: {
        my $permutation = .key;
        my $term = $op eq 'perm' ?? 1 !! .value;
        for $permutation.kv -> $i, $j { $term *= @a[$i][$j] };
        $term
    }
}

######### helper subs #########
sub hilbert-matrix (\h) {[(1..h).map(-> \n {[(n..^n+h).map: {(1/$_).FatRat}]})]}

sub rat-or-int ($num) {
    return $num unless $num ~~ Rat|FatRat;
    return $num.narrow if $num.narrow.WHAT ~~ Int;
    $num.nude.join: '/';
}

sub say-it ($message, @array) {
    my $max;
    @array.map: {$max max= max $_».&rat-or-int.comb(/\S+/)».chars};
    say "\n$message";
    $_».&rat-or-int.fmt(" %{$max}s").put for @array;
}

########### Testing ###########
my @tests = (
    [
        [ 1, 2 ],
        [ 3, 4 ]
    ],
    [
        [  1,  2,  3,  4 ],
        [  4,  5,  6,  7 ],
        [  7,  8,  9, 10 ],
        [ 10, 11, 12, 13 ]
    ],
    hilbert-matrix 7
);

for @tests -> @matrix {
    say-it 'Matrix:', @matrix;
    say "Determinant:\t", rat-or-int @matrix.&m_arith: <det>;
    say "Permanent:  \t", rat-or-int @matrix.&m_arith: <perm>;
    say '-' x 40;
}

```

**Output**

```
Matrix:
 1  2
 3  4
Determinant:	-2
Permanent:  	10
----------------------------------------

Matrix:
  1   2   3   4
  4   5   6   7
  7   8   9  10
 10  11  12  13
Determinant:	0
Permanent:  	29556
----------------------------------------

Matrix:
    1   1/2   1/3   1/4   1/5   1/6   1/7
  1/2   1/3   1/4   1/5   1/6   1/7   1/8
  1/3   1/4   1/5   1/6   1/7   1/8   1/9
  1/4   1/5   1/6   1/7   1/8   1/9  1/10
  1/5   1/6   1/7   1/8   1/9  1/10  1/11
  1/6   1/7   1/8   1/9  1/10  1/11  1/12
  1/7   1/8   1/9  1/10  1/11  1/12  1/13
Determinant:	1/2067909047925770649600000
Permanent:  	29453515169174062608487/2067909047925770649600000
----------------------------------------
```


[User]
Task

Given a character string   (which may be empty, or have a length of zero characters):

:   :   * create a function/procedure/routine to:

        :   :   * determine if all the characters in the string are the same
                * indicate if or which character is different from the previous character

        * display each string and its length   (as the strings are being examined)
        * a zero─length (empty) string shall be considered as all the same character(s)
        * process the strings from left─to─right
        * if       all the same character,   display a message saying such
        * if not all the same character,   then:

        :   :   * display a message saying such
                * display what character is different
                * only the 1st different character need be displayed
                * display where the different character is in the string
                * the above messages can be part of a single message
                * display the hexadecimal value of the different character

Use (at least) these seven test values   (strings):

:   :   :   * a string of length   0   (an empty string)
            * a string of length   3   which contains three blanks
            * a string of length   1   which contains:   **2**
            * a string of length   3   which contains:   **333**
            * a string of length   3   which contains:   **.55**
            * a string of length   6   which contains:   **tttTTT**
            * a string of length   9   with a blank in the middle:   **4444   444k**

Show all output here on this page.

Other tasks related to string operations:

Metrics

* Array length
* String length
* Copy a string
* Empty string  (assignment)

Counting

* Word frequency
* Letter frequency
* Jewels and stones
* I before E except after C
* Bioinformatics/base count
* Count occurrences of a substring
* Count how many vowels and consonants occur in a string

Remove/replace

* XXXX redacted
* Conjugate a Latin verb
* Remove vowels from a string
* String interpolation (included)
* Strip block comments
* Strip comments from a string
* Strip a set of characters from a string
* Strip whitespace from a string -- top and tail
* Strip control codes and extended characters from a string

Anagrams/Derangements/shuffling

* Word wheel
* ABC problem
* Sattolo cycle
* Knuth shuffle
* Ordered words
* Superpermutation minimisation
* Textonyms (using a phone text pad)
* Anagrams
* Anagrams/Deranged anagrams
* Permutations/Derangements

Find/Search/Determine

* ABC words
* Odd words
* Word ladder
* Semordnilap
* Word search
* Wordiff  (game)
* String matching
* Tea cup rim text
* Alternade words
* Changeable words
* State name puzzle
* String comparison
* Unique characters
* Unique characters in each string
* Extract file extension
* Levenshtein distance
* Palindrome detection
* Common list elements
* Longest common suffix
* Longest common prefix
* Compare a list of strings
* Longest common substring
* Find common directory path
* Words from neighbour ones
* Change e letters to i in words
* Non-continuous subsequences
* Longest common subsequence
* Longest palindromic substrings
* Longest increasing subsequence
* Words containing "the" substring
* Sum of the digits of n is substring of n
* Determine if a string is numeric
* Determine if a string is collapsible
* Determine if a string is squeezable
* Determine if a string has all unique characters
* Determine if a string has all the same characters
* Longest substrings without repeating characters
* Find words which contains all the vowels
* Find words which contain the most consonants
* Find words which contains more than 3 vowels
* Find words whose first and last three letters are equal
* Find words with alternating vowels and consonants

Formatting

* Substring
* Rep-string
* Word wrap
* String case
* Align columns
* Literals/String
* Repeat a string
* Brace expansion
* Brace expansion using ranges
* Reverse a string
* Phrase reversals
* Comma quibbling
* Special characters
* String concatenation
* Substring/Top and tail
* Commatizing numbers
* Reverse words in a string
* Suffixation of decimal numbers
* Long literals, with continuations
* Numerical and alphabetical suffixes
* Abbreviations, easy
* Abbreviations, simple
* Abbreviations, automatic

Song lyrics/poems/Mad Libs/phrases

* Mad Libs
* Magic 8-ball
* 99 bottles of beer
* The Name Game (a song)
* The Old lady swallowed a fly
* The Twelve Days of Christmas

Tokenize

* Text between
* Tokenize a string
* Word break problem
* Tokenize a string with escaping
* Split a character string based on change of character

Sequences

* Show ASCII table
* De Bruijn sequences
* Summarize and say sequence
* Generate lower case ASCII alphabet

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2020.08.1

The last string demonstrates how Raku can recognize that glyphs made up of different combinations of combining characters can compare the same. It is built up from explicit codepoints to show that each of the glyphs is made up of different combinations.

```
  -> $str {
    my $i = 0;
    print "\n{$str.raku} (length: {$str.chars}), has ";
    my %m;
    %m{$_}.push: ++$i for $str.comb;

    if %m > 1 {
        say "different characters:";
        say "'{.key}' ({.key.uninames}; hex ordinal: {(.key.ords).fmt: "0x%X"})" ~
        " in positions: {.value.join: ', '}" for %m.sort( *.value[0] );
    } else {
        say "the same character in all positions."
    }
} for
    '',
    '   ',
    '2',
    '333',
    '.55',
    'tttTTT',
    '4444 444k',
    '🇬🇧🇬🇧🇬🇧🇬🇧',
    "\c[LATIN CAPITAL LETTER A]\c[COMBINING DIAERESIS]\c[COMBINING MACRON]" ~
    "\c[LATIN CAPITAL LETTER A WITH DIAERESIS]\c[COMBINING MACRON]" ~
    "\c[LATIN CAPITAL LETTER A WITH DIAERESIS AND MACRON]",
    'AАΑꓮ𐌀𐊠Ꭺ'

```

Output:

```
"" (length: 0), has the same character in all positions.

"   " (length: 3), has the same character in all positions.

"2" (length: 1), has the same character in all positions.

"333" (length: 3), has the same character in all positions.

".55" (length: 3), has different characters:
'.' (FULL STOP; hex ordinal: 0x2E) in positions: 1
'5' (DIGIT FIVE; hex ordinal: 0x35) in positions: 2, 3

"tttTTT" (length: 6), has different characters:
't' (LATIN SMALL LETTER T; hex ordinal: 0x74) in positions: 1, 2, 3
'T' (LATIN CAPITAL LETTER T; hex ordinal: 0x54) in positions: 4, 5, 6

"4444 444k" (length: 9), has different characters:
'4' (DIGIT FOUR; hex ordinal: 0x34) in positions: 1, 2, 3, 4, 6, 7, 8
' ' (SPACE; hex ordinal: 0x20) in positions: 5
'k' (LATIN SMALL LETTER K; hex ordinal: 0x6B) in positions: 9

"🇬🇧🇬🇧🇬🇧🇬🇧" (length: 4), has the same character in all positions.

"ǞǞǞ" (length: 3), has the same character in all positions.

"AАΑꓮ𐌀𐊠Ꭺ" (length: 7), has different characters:
'A' (LATIN CAPITAL LETTER A; hex ordinal: 0x41) in positions: 1
'А' (CYRILLIC CAPITAL LETTER A; hex ordinal: 0x410) in positions: 2
'Α' (GREEK CAPITAL LETTER ALPHA; hex ordinal: 0x391) in positions: 3
'ꓮ' (LISU LETTER A; hex ordinal: 0xA4EE) in positions: 4
'𐌀' (OLD ITALIC LETTER A; hex ordinal: 0x10300) in positions: 5
'𐊠' (CARIAN LETTER A; hex ordinal: 0x102A0) in positions: 6
'Ꭺ' (CHEROKEE LETTER GO; hex ordinal: 0x13AA) in positions: 7
```


[User]
Task

Given a character string   (which may be empty, or have a length of zero characters):

:   :   * create a function/procedure/routine to:

        :   :   * determine if all the characters in the string are unique
                * indicate if or which character is duplicated and where

        * display each string and its length   (as the strings are being examined)
        * a zero─length (empty) string shall be considered as unique
        * process the strings from left─to─right
        * if       unique,   display a message saying such
        * if not unique,   then:

        :   :   * display a message saying such
                * display what character is duplicated
                * only the 1st non─unique character need be displayed
                * display where "both" duplicated characters are in the string
                * the above messages can be part of a single message
                * display the hexadecimal value of the duplicated character

Use (at least) these five test values   (strings):

:   :   :   * a string of length     0   (an empty string)
            * a string of length     1   which is a single period   (**.**)
            * a string of length     6   which contains:   **abcABC**
            * a string of length     7   which contains a blank in the middle:   **XYZ  ZYX**
            * a string of length   36   which   *doesn't*   contain the letter "oh":

            :   :   :   :   :   **1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ**

Show all output here on this page.

Other tasks related to string operations:

Metrics

* Array length
* String length
* Copy a string
* Empty string  (assignment)

Counting

* Word frequency
* Letter frequency
* Jewels and stones
* I before E except after C
* Bioinformatics/base count
* Count occurrences of a substring
* Count how many vowels and consonants occur in a string

Remove/replace

* XXXX redacted
* Conjugate a Latin verb
* Remove vowels from a string
* String interpolation (included)
* Strip block comments
* Strip comments from a string
* Strip a set of characters from a string
* Strip whitespace from a string -- top and tail
* Strip control codes and extended characters from a string

Anagrams/Derangements/shuffling

* Word wheel
* ABC problem
* Sattolo cycle
* Knuth shuffle
* Ordered words
* Superpermutation minimisation
* Textonyms (using a phone text pad)
* Anagrams
* Anagrams/Deranged anagrams
* Permutations/Derangements

Find/Search/Determine

* ABC words
* Odd words
* Word ladder
* Semordnilap
* Word search
* Wordiff  (game)
* String matching
* Tea cup rim text
* Alternade words
* Changeable words
* State name puzzle
* String comparison
* Unique characters
* Unique characters in each string
* Extract file extension
* Levenshtein distance
* Palindrome detection
* Common list elements
* Longest common suffix
* Longest common prefix
* Compare a list of strings
* Longest common substring
* Find common directory path
* Words from neighbour ones
* Change e letters to i in words
* Non-continuous subsequences
* Longest common subsequence
* Longest palindromic substrings
* Longest increasing subsequence
* Words containing "the" substring
* Sum of the digits of n is substring of n
* Determine if a string is numeric
* Determine if a string is collapsible
* Determine if a string is squeezable
* Determine if a string has all unique characters
* Determine if a string has all the same characters
* Longest substrings without repeating characters
* Find words which contains all the vowels
* Find words which contain the most consonants
* Find words which contains more than 3 vowels
* Find words whose first and last three letters are equal
* Find words with alternating vowels and consonants

Formatting

* Substring
* Rep-string
* Word wrap
* String case
* Align columns
* Literals/String
* Repeat a string
* Brace expansion
* Brace expansion using ranges
* Reverse a string
* Phrase reversals
* Comma quibbling
* Special characters
* String concatenation
* Substring/Top and tail
* Commatizing numbers
* Reverse words in a string
* Suffixation of decimal numbers
* Long literals, with continuations
* Numerical and alphabetical suffixes
* Abbreviations, easy
* Abbreviations, simple
* Abbreviations, automatic

Song lyrics/poems/Mad Libs/phrases

* Mad Libs
* Magic 8-ball
* 99 bottles of beer
* The Name Game (a song)
* The Old lady swallowed a fly
* The Twelve Days of Christmas

Tokenize

* Text between
* Tokenize a string
* Word break problem
* Tokenize a string with escaping
* Split a character string based on change of character

Sequences

* Show ASCII table
* De Bruijn sequences
* Summarize and say sequence
* Generate lower case ASCII alphabet

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2020.08.1

Raku works with unicode natively and handles combining characters and multi-byte emoji correctly. In the last string, notice the the length is correctly shown as 11 characters and that the delta with a combining circumflex in position 6 is not the same as the deltas without in positions 5 & 9.

```
  -> $str {
    my $i = 0;
    print "\n{$str.raku} (length: {$str.chars}), has ";
    my %m = $str.comb.Bag;
    if any(%m.values) > 1 {
        say "duplicated characters:";
        say "'{.key}' ({.key.uninames}; hex ordinal: {(.key.ords).fmt: "0x%X"})" ~
        " in positions: {.value.join: ', '}" for %m.grep( *.value > 1 ).sort( *.value[0] );
    } else {
        say "no duplicated characters."
    }
} for
    '',
    '.',
    'abcABC',
    'XYZ ZYX',
    '1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ',
    '01234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ0X',
    '🦋🙂👨👩👧👦🙄ΔΔ̂ 🦋Δ👍👨👩👧👦'

```

Output:

```
"" (length: 0), has no duplicated characters.

"." (length: 1), has no duplicated characters.

"abcABC" (length: 6), has no duplicated characters.

"XYZ ZYX" (length: 7), has duplicated characters:
'X' (LATIN CAPITAL LETTER X; hex ordinal: 0x58) in positions: 1, 7
'Y' (LATIN CAPITAL LETTER Y; hex ordinal: 0x59) in positions: 2, 6
'Z' (LATIN CAPITAL LETTER Z; hex ordinal: 0x5A) in positions: 3, 5

"1234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ" (length: 36), has duplicated characters:
'0' (DIGIT ZERO; hex ordinal: 0x30) in positions: 10, 25

"01234567890ABCDEFGHIJKLMN0PQRSTUVWXYZ0X" (length: 39), has duplicated characters:
'0' (DIGIT ZERO; hex ordinal: 0x30) in positions: 1, 11, 26, 38
'X' (LATIN CAPITAL LETTER X; hex ordinal: 0x58) in positions: 35, 39

"🦋🙂👨👩👧👦🙄ΔΔ̂ 🦋Δ👍👨👩👧👦" (length: 11), has duplicated characters:
'🦋' (BUTTERFLY; hex ordinal: 0x1F98B) in positions: 1, 8
'👨👩👧👦' (MAN ZERO WIDTH JOINER WOMAN ZERO WIDTH JOINER GIRL ZERO WIDTH JOINER BOY; hex ordinal: 0x1F468 0x200D 0x1F469 0x200D 0x1F467 0x200D 0x1F466) in positions: 3, 11
'Δ' (GREEK CAPITAL LETTER DELTA; hex ordinal: 0x394) in positions: 5, 9

```


[User]
Determine if a character string is   *collapsible*.

And if so,   collapse the string   (by removing   *immediately repeated*   characters).

If a character string has   *immediately repeated*   character(s),   the repeated characters are to be
deleted (removed),   but not the primary (1st) character(s).

An   *immediately repeated*   character is any character that is   immediately   followed by an
identical character (or characters).   Another word choice could've been   *duplicated character*,   but that
might have ruled out   (to some readers)   triplicated characters   ···   or more.

{This Rosetta Code task was inspired by a newly introduced   (as of around November 2019)   **PL/I**   BIF:   **collapse**.}

Examples

In the following character string:

```
 The better the 4-wheel drive, the further you'll be from help when ya get stuck!

```

Only the 2nd   **t**,   **e**, and   **l**   are repeated characters,   indicated
by underscores (above),   even though they (those characters) appear elsewhere in the character string.

So, after *collapsing* the string, the result would be:

```
 The beter the 4-whel drive, the further you'l be from help when ya get stuck!

```

Another example:
In the following character string:

```
 headmistressship

```

The "collapsed" string would be:

```
 headmistreship

```

Task

Write a subroutine/function/procedure/routine···   to
locate   *repeated*   characters and   *collapse*   (delete)   them from the character
string.   The character string can be processed from either direction.

Show all output here, on this page:

:   * the   original string and its length
    * the resultant string and its length
    * the above strings should be "bracketed" with   **<<<**   and   **>>>**   (to delineate blanks)
    * «««Guillemets may be used instead for "bracketing" for the more artistic programmers,   shown used here»»»

Use (at least) the following five strings,   all strings are length seventy-two (characters, including blanks),   except
the 1st string:

```
 string
 number
        ╔╗
   1    ║╚═══════════════════════════════════════════════════════════════════════╗   ◄■■■■■■  a null string  (length zero)
   2    ║"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ║
   3    ║..1111111111111111111111111111111111111111111111111111111111111117777888║
   4    ║I never give 'em hell, I just tell the truth, and they think it's hell. ║
   5    ║                                                    --- Harry S Truman  ║   ◄■■■■■■  has many repeated blanks
        ╚════════════════════════════════════════════════════════════════════════╝

```

Other tasks related to string operations:

Metrics

* Array length
* String length
* Copy a string
* Empty string  (assignment)

Counting

* Word frequency
* Letter frequency
* Jewels and stones
* I before E except after C
* Bioinformatics/base count
* Count occurrences of a substring
* Count how many vowels and consonants occur in a string

Remove/replace

* XXXX redacted
* Conjugate a Latin verb
* Remove vowels from a string
* String interpolation (included)
* Strip block comments
* Strip comments from a string
* Strip a set of characters from a string
* Strip whitespace from a string -- top and tail
* Strip control codes and extended characters from a string

Anagrams/Derangements/shuffling

* Word wheel
* ABC problem
* Sattolo cycle
* Knuth shuffle
* Ordered words
* Superpermutation minimisation
* Textonyms (using a phone text pad)
* Anagrams
* Anagrams/Deranged anagrams
* Permutations/Derangements

Find/Search/Determine

* ABC words
* Odd words
* Word ladder
* Semordnilap
* Word search
* Wordiff  (game)
* String matching
* Tea cup rim text
* Alternade words
* Changeable words
* State name puzzle
* String comparison
* Unique characters
* Unique characters in each string
* Extract file extension
* Levenshtein distance
* Palindrome detection
* Common list elements
* Longest common suffix
* Longest common prefix
* Compare a list of strings
* Longest common substring
* Find common directory path
* Words from neighbour ones
* Change e letters to i in words
* Non-continuous subsequences
* Longest common subsequence
* Longest palindromic substrings
* Longest increasing subsequence
* Words containing "the" substring
* Sum of the digits of n is substring of n
* Determine if a string is numeric
* Determine if a string is collapsible
* Determine if a string is squeezable
* Determine if a string has all unique characters
* Determine if a string has all the same characters
* Longest substrings without repeating characters
* Find words which contains all the vowels
* Find words which contain the most consonants
* Find words which contains more than 3 vowels
* Find words whose first and last three letters are equal
* Find words with alternating vowels and consonants

Formatting

* Substring
* Rep-string
* Word wrap
* String case
* Align columns
* Literals/String
* Repeat a string
* Brace expansion
* Brace expansion using ranges
* Reverse a string
* Phrase reversals
* Comma quibbling
* Special characters
* String concatenation
* Substring/Top and tail
* Commatizing numbers
* Reverse words in a string
* Suffixation of decimal numbers
* Long literals, with continuations
* Numerical and alphabetical suffixes
* Abbreviations, easy
* Abbreviations, simple
* Abbreviations, automatic

Song lyrics/poems/Mad Libs/phrases

* Mad Libs
* Magic 8-ball
* 99 bottles of beer
* The Name Game (a song)
* The Old lady swallowed a fly
* The Twelve Days of Christmas

Tokenize

* Text between
* Tokenize a string
* Word break problem
* Tokenize a string with escaping
* Split a character string based on change of character

Sequences

* Show ASCII table
* De Bruijn sequences
* Summarize and say sequence
* Generate lower case ASCII alphabet

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.07.1

Technically, the task is asking for a boolean. "Determine if a string is collapsible" is answerable with True/False, so return a boolean as well.

```
map {
    my $squish = .comb.squish.join;
    printf "\nLength: %2d <<<%s>>>\nCollapsible: %s\nLength: %2d <<<%s>>>\n",
      .chars, $_, .chars != $squish.chars, $squish.chars, $squish
}, lines

q:to/STRINGS/;

    "If I were two-faced, would I be wearing this one?" --- Abraham Lincoln
    ..1111111111111111111111111111111111111111111111111111111111111117777888
    I never give 'em hell, I just tell the truth, and they think it's hell.
                                                        --- Harry S Truman
    The American people have a right to know if their president is a crook.
                                                        --- Richard Nixon
    AАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑ
    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
    STRINGS

```

Output:

```
Length:  0 <<<>>>
Collapsible: False
Length:  0 <<<>>>

Length: 72 <<<"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln >>>
Collapsible: True
Length: 70 <<<"If I were two-faced, would I be wearing this one?" - Abraham Lincoln >>>

Length: 72 <<<..1111111111111111111111111111111111111111111111111111111111111117777888>>>
Collapsible: True
Length:  4 <<<.178>>>

Length: 72 <<<I never give 'em hell, I just tell the truth, and they think it's hell. >>>
Collapsible: True
Length: 69 <<<I never give 'em hel, I just tel the truth, and they think it's hel. >>>

Length: 72 <<<                                                    --- Harry S Truman  >>>
Collapsible: True
Length: 17 <<< - Hary S Truman >>>

Length: 72 <<<The American people have a right to know if their president is a crook. >>>
Collapsible: True
Length: 71 <<<The American people have a right to know if their president is a crok. >>>

Length: 72 <<<                                                    --- Richard Nixon   >>>
Collapsible: True
Length: 17 <<< - Richard Nixon >>>

Length: 72 <<<AАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑ>>>
Collapsible: False
Length: 72 <<<AАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑAАΑ>>>

Length: 72 <<<AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA>>>
Collapsible: True
Length:  1 <<<A>>>

```


[User]
Task

Create a boolean function which takes in a string and tells whether it is a numeric string (floating point and negative numbers included) in the syntax the language uses for numeric literals or numbers converted from strings.

Other tasks related to string operations:

Metrics

* Array length
* String length
* Copy a string
* Empty string  (assignment)

Counting

* Word frequency
* Letter frequency
* Jewels and stones
* I before E except after C
* Bioinformatics/base count
* Count occurrences of a substring
* Count how many vowels and consonants occur in a string

Remove/replace

* XXXX redacted
* Conjugate a Latin verb
* Remove vowels from a string
* String interpolation (included)
* Strip block comments
* Strip comments from a string
* Strip a set of characters from a string
* Strip whitespace from a string -- top and tail
* Strip control codes and extended characters from a string

Anagrams/Derangements/shuffling

* Word wheel
* ABC problem
* Sattolo cycle
* Knuth shuffle
* Ordered words
* Superpermutation minimisation
* Textonyms (using a phone text pad)
* Anagrams
* Anagrams/Deranged anagrams
* Permutations/Derangements

Find/Search/Determine

* ABC words
* Odd words
* Word ladder
* Semordnilap
* Word search
* Wordiff  (game)
* String matching
* Tea cup rim text
* Alternade words
* Changeable words
* State name puzzle
* String comparison
* Unique characters
* Unique characters in each string
* Extract file extension
* Levenshtein distance
* Palindrome detection
* Common list elements
* Longest common suffix
* Longest common prefix
* Compare a list of strings
* Longest common substring
* Find common directory path
* Words from neighbour ones
* Change e letters to i in words
* Non-continuous subsequences
* Longest common subsequence
* Longest palindromic substrings
* Longest increasing subsequence
* Words containing "the" substring
* Sum of the digits of n is substring of n
* Determine if a string is numeric
* Determine if a string is collapsible
* Determine if a string is squeezable
* Determine if a string has all unique characters
* Determine if a string has all the same characters
* Longest substrings without repeating characters
* Find words which contains all the vowels
* Find words which contain the most consonants
* Find words which contains more than 3 vowels
* Find words whose first and last three letters are equal
* Find words with alternating vowels and consonants

Formatting

* Substring
* Rep-string
* Word wrap
* String case
* Align columns
* Literals/String
* Repeat a string
* Brace expansion
* Brace expansion using ranges
* Reverse a string
* Phrase reversals
* Comma quibbling
* Special characters
* String concatenation
* Substring/Top and tail
* Commatizing numbers
* Reverse words in a string
* Suffixation of decimal numbers
* Long literals, with continuations
* Numerical and alphabetical suffixes
* Abbreviations, easy
* Abbreviations, simple
* Abbreviations, automatic

Song lyrics/poems/Mad Libs/phrases

* Mad Libs
* Magic 8-ball
* 99 bottles of beer
* The Name Game (a song)
* The Old lady swallowed a fly
* The Twelve Days of Christmas

Tokenize

* Text between
* Tokenize a string
* Word break problem
* Tokenize a string with escaping
* Split a character string based on change of character

Sequences

* Show ASCII table
* De Bruijn sequences
* Summarize and say sequence
* Generate lower case ASCII alphabet

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2017.11

Raku tries very hard to DWIM (do what I mean). As part of that, numeric strings are by default stored as allomorphic types which can be used as numbers or strings without any conversion. If we truly want to operate on strings, we have to explicitly coerce the allomorphs to strings. A subtlety that may not be immediately apparent, whitespace, empty strings and null strings may be treated as (False) boolean values in Raku, however booleans are allomorphic to numeric, so empty strings will coerce to a numeric value (0), and return as numeric unless specifically checked for. Interestingly, the actual strings 'True' and 'False' **don't** evaluate as numeric. (because there are no String | Boolean allomorphs.)

Note: These routines are usable for most cases but won't detect unicode non-digit numeric forms; E.G. vulgar fractions, Roman numerals, circled numbers, etc. If it is necessary to detect those as numeric, a full fledged grammar may be necessary.

```
sub is-number-w-ws( Str $term --> Bool ) { # treat Falsey strings as numeric
    $term.Numeric !~~ Failure;
}

sub is-number-wo-ws( Str $term --> Bool ) { # treat Falsey strings as non-numeric
    ?($term ~~ / \S /) && $term.Numeric !~~ Failure;
}

say "               Coerce     Don't coerce";
say '    String   whitespace    whitespace';
printf "%10s  %8s  %11s\n",
"<$_>", .&is-number-w-ws, .&is-number-wo-ws for
(|<1 1.2 1.2.3 -6 1/2 12e B17 1.3e+12 1.3e12 -2.6e-3 zero 0x 0xA10 0b1001 0o16
0o18 2+5i True False Inf NaN 0x10.50 0b102 0o_5_3 ௫௯>, '  12  ', '1 1 1', '', ' ' ).map: *.Str;
```

```
               Coerce     Don't coerce
    String   whitespace    whitespace
       <1>      True         True
     <1.2>      True         True
   <1.2.3>     False        False
      <-6>      True         True
     <1/2>      True         True
     <12e>     False        False
     <B17>     False        False
 <1.3e+12>      True         True
  <1.3e12>      True         True
 <-2.6e-3>      True         True
    <zero>     False        False
      <0x>     False        False
   <0xA10>      True         True
  <0b1001>      True         True
    <0o16>      True         True
    <0o18>     False        False
    <2+5i>      True         True
    <True>     False        False
   <False>     False        False
     <Inf>      True         True
     <NaN>      True         True
 <0x10.50>      True         True
   <0b102>     False        False
  <0o_5_3>      True         True
      <௫௯>      True         True
 <   12  >      True         True
   <1 1 1>     False        False
        <>      True        False
       < >      True        False
```


[User]
Determine if a character string is   *squeezable*.

And if so,   squeeze the string   (by removing any number of
a   *specified*   *immediately repeated*   character).

This task is very similar to the task     **Determine if a character string is collapsible**     except
that only a specified character is   *squeezed*   instead of any character that is *immediately repeated*.

If a character string has a specified   *immediately repeated*   character(s),   the repeated characters are to be
deleted (removed),   but not the primary (1st) character(s).

A specified   *immediately repeated*   character is any specified character that is   immediately
followed by an identical character (or characters).   Another word choice could've been   *duplicated*
character*,   but that might have ruled out   (to some readers)   triplicated characters   ···   or more.*

{This Rosetta Code task was inspired by a newly introduced   (as of around
November 2019)   **PL/I**   BIF:   **squeeze**.}

Examples

In the following character string with a specified   *immediately repeated*   character of   **e**:

```
 The better the 4-wheel drive, the further you'll be from help when ya get stuck!

```

Only the 2nd   **e**   is an specified repeated character,   indicated by an underscore
(above),   even though they (the characters) appear elsewhere in the character string.

So, after *squeezing* the string, the result would be:

```
 The better the 4-whel drive, the further you'll be from help when ya get stuck!

```

Another example:
In the following character string,   using a specified immediately repeated character   **s**:

```
 headmistressship

```

The "squeezed" string would be:

```
 headmistreship

```

Task

Write a subroutine/function/procedure/routine···   to locate a   *specified immediately repeated*   character
and   *squeeze*   (delete)   them from the character string.   The
character string can be processed from either direction.

Show all output here, on this page:

:   * the   specified repeated character   (to be searched for and possibly *squeezed*):
    * the   original string and its length
    * the resultant string and its length
    * the above strings should be "bracketed" with   **<<<**   and   **>>>**   (to delineate blanks)
    * «««Guillemets may be used instead for "bracketing" for the more artistic programmers,   shown used here»»»

Use (at least) the following five strings,   all strings are length seventy-two (characters, including blanks),   except
the 1st string:

```
                                                                                immediately
 string                                                                            repeated
 number                                                                            character
                                                                                ( ↓   a blank,  a minus,  a seven,  a period)
        ╔╗
   1    ║╚═══════════════════════════════════════════════════════════════════════╗    ' '    ◄■■■■■■  a null string  (length zero)
   2    ║"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ║    '-'
   3    ║..1111111111111111111111111111111111111111111111111111111111111117777888║    '7'
   4    ║I never give 'em hell, I just tell the truth, and they think it's hell. ║    '.'
   5    ║                                                    --- Harry S Truman  ║  (below)  ◄■■■■■■  has many repeated blanks
        ╚════════════════════════════════════════════════════════════════════════╝     ↑
                                                                                │
                                                                                │
        For the 5th string  (Truman's signature line),  use each of these  specified immediately  repeated characters:
                                  •  a blank
                                  •  a minus
                                  •  a lowercase  r

```

Note:   there should be seven results shown,   one each for the 1st four strings,   and three results for
the 5th string.

Other tasks related to string operations:

Metrics

* Array length
* String length
* Copy a string
* Empty string  (assignment)

Counting

* Word frequency
* Letter frequency
* Jewels and stones
* I before E except after C
* Bioinformatics/base count
* Count occurrences of a substring
* Count how many vowels and consonants occur in a string

Remove/replace

* XXXX redacted
* Conjugate a Latin verb
* Remove vowels from a string
* String interpolation (included)
* Strip block comments
* Strip comments from a string
* Strip a set of characters from a string
* Strip whitespace from a string -- top and tail
* Strip control codes and extended characters from a string

Anagrams/Derangements/shuffling

* Word wheel
* ABC problem
* Sattolo cycle
* Knuth shuffle
* Ordered words
* Superpermutation minimisation
* Textonyms (using a phone text pad)
* Anagrams
* Anagrams/Deranged anagrams
* Permutations/Derangements

Find/Search/Determine

* ABC words
* Odd words
* Word ladder
* Semordnilap
* Word search
* Wordiff  (game)
* String matching
* Tea cup rim text
* Alternade words
* Changeable words
* State name puzzle
* String comparison
* Unique characters
* Unique characters in each string
* Extract file extension
* Levenshtein distance
* Palindrome detection
* Common list elements
* Longest common suffix
* Longest common prefix
* Compare a list of strings
* Longest common substring
* Find common directory path
* Words from neighbour ones
* Change e letters to i in words
* Non-continuous subsequences
* Longest common subsequence
* Longest palindromic substrings
* Longest increasing subsequence
* Words containing "the" substring
* Sum of the digits of n is substring of n
* Determine if a string is numeric
* Determine if a string is collapsible
* Determine if a string is squeezable
* Determine if a string has all unique characters
* Determine if a string has all the same characters
* Longest substrings without repeating characters
* Find words which contains all the vowels
* Find words which contain the most consonants
* Find words which contains more than 3 vowels
* Find words whose first and last three letters are equal
* Find words with alternating vowels and consonants

Formatting

* Substring
* Rep-string
* Word wrap
* String case
* Align columns
* Literals/String
* Repeat a string
* Brace expansion
* Brace expansion using ranges
* Reverse a string
* Phrase reversals
* Comma quibbling
* Special characters
* String concatenation
* Substring/Top and tail
* Commatizing numbers
* Reverse words in a string
* Suffixation of decimal numbers
* Long literals, with continuations
* Numerical and alphabetical suffixes
* Abbreviations, easy
* Abbreviations, simple
* Abbreviations, automatic

Song lyrics/poems/Mad Libs/phrases

* Mad Libs
* Magic 8-ball
* 99 bottles of beer
* The Name Game (a song)
* The Old lady swallowed a fly
* The Twelve Days of Christmas

Tokenize

* Text between
* Tokenize a string
* Word break problem
* Tokenize a string with escaping
* Split a character string based on change of character

Sequences

* Show ASCII table
* De Bruijn sequences
* Summarize and say sequence
* Generate lower case ASCII alphabet

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2019.07.1

```
map {
    my $squeeze = $^phrase;
    sink $^reg;
    $squeeze ~~ s:g/($reg)$0+/$0/;
    printf "\nOriginal length: %d <<<%s>>>\nSqueezable on \"%s\": %s\nSqueezed length: %d <<<%s>>>\n",
      $phrase.chars, $phrase, $reg.uniname, $phrase ne $squeeze, $squeeze.chars, $squeeze
},
  '', ' ',
  '"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln ', '-',
  '..1111111111111111111111111111111111111111111111111111111111111117777888', '7',
  "I never give 'em hell, I just tell the truth, and they think it's hell. ", '.',
  '                                                    --- Harry S Truman  ', ' ',
  '                                                    --- Harry S Truman  ', '-',
  '                                                    --- Harry S Truman  ', 'r'

```

Output:

```
Original length: 0 <<<>>>
Squeezable on "SPACE": False
Squeezed length: 0 <<<>>>

Original length: 72 <<<"If I were two-faced, would I be wearing this one?" --- Abraham Lincoln >>>
Squeezable on "HYPHEN-MINUS": True
Squeezed length: 70 <<<"If I were two-faced, would I be wearing this one?" - Abraham Lincoln >>>

Original length: 72 <<<..1111111111111111111111111111111111111111111111111111111111111117777888>>>
Squeezable on "DIGIT SEVEN": True
Squeezed length: 69 <<<..1111111111111111111111111111111111111111111111111111111111111117888>>>

Original length: 72 <<<I never give 'em hell, I just tell the truth, and they think it's hell. >>>
Squeezable on "FULL STOP": False
Squeezed length: 72 <<<I never give 'em hell, I just tell the truth, and they think it's hell. >>>

Original length: 72 <<<                                                    --- Harry S Truman  >>>
Squeezable on "SPACE": True
Squeezed length: 20 <<< --- Harry S Truman >>>

Original length: 72 <<<                                                    --- Harry S Truman  >>>
Squeezable on "HYPHEN-MINUS": True
Squeezed length: 70 <<<                                                    - Harry S Truman  >>>

Original length: 72 <<<                                                    --- Harry S Truman  >>>
Squeezable on "LATIN SMALL LETTER R": True
Squeezed length: 71 <<<                                                    --- Hary S Truman  >>>

```


[User] This task is to determine if there is only one instance of an application running. If the program discovers that an instance of it is already running, then it should display a message indicating that it is already running and exit.

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2018.03

An old-school Unix solution, none the worse for the wear:

```
my $name = $*PROGRAM-NAME;
my $pid = $*PID;

my $lockdir = "/tmp";
my $lockfile = "$lockdir/$name.pid";
my $lockpid = "$lockfile$pid";
my $havelock = False;

END {
    unlink $lockfile if $havelock;
    try unlink $lockpid;
}

my $pidfile = open "$lockpid", :w orelse .die;
$pidfile.say($pid);
$pidfile.close;

if try link($lockpid, $lockfile) {
    $havelock = True;
}
else {
    shell "kill -CONT `cat $lockfile` || rm $lockfile";
    if try link($lockfile, $lockpid) {
        $havelock = True;
    }
    else {
        die "You can't run right now!";
    }
}
note "Got lock!";
unlink $lockpid;

```


[User]
Determining if two triangles in the same plane overlap is an important topic in collision detection.

Task

Determine which of these pairs of triangles overlap in 2D:

:   :   :   * (0,0),(5,0),(0,5)     and   (0,0),(5,0),(0,6)
            * (0,0),(0,5),(5,0)     and   (0,0),(0,5),(5,0)
            * (0,0),(5,0),(0,5)     and   (-10,0),(-5,0),(-1,6)
            * (0,0),(5,0),(2.5,5)   and   (0,4),(2.5,-1),(5,4)
            * (0,0),(1,1),(0,2)     and   (2,1),(3,0),(3,2)
            * (0,0),(1,1),(0,2)     and   (2,1),(3,-2),(3,4)

Optionally, see what the result is when only a single corner is in contact (there is no definitive correct answer):

:   :   :   * (0,0),(1,0),(0,1)   and   (1,0),(2,0),(1,1)

Related tasks

* Check if two polygons overlap
* Check if a polygon overlaps with a rectangle

[Assistant]
(formerly Perl 6)
First, check if any vertex is inside each other triangle (that should cover most overlapping cases including enclosures). Then see if an edge of triangle A intersects any of two edges of B (for shapes like Star of David [1])

```
# Reference:
# https://stackoverflow.com/questions/2049582/how-to-determine-if-a-point-is-in-a-2d-triangle
# https://www.geeksforgeeks.org/check-if-two-given-line-segments-intersect/

sub if-overlap ($triangle-pair) {
   my (\A,\B) = $triangle-pair;
   my Bool $result = False;

   sub sign (\T) {
      return (T[0;0] - T[2;0]) × (T[1;1] - T[2;1]) -
             (T[1;0] - T[2;0]) × (T[0;1] - T[2;1]);
   }

   sub point-in-triangle (\pt, \Y --> Bool) {
      my $d1 = sign (pt, Y[0], Y[1]);
      my $d2 = sign (pt, Y[1], Y[2]);
      my $d3 = sign (pt, Y[2], Y[0]);

      my $has_neg = [or] $d1 < 0, $d2 < 0, $d3 < 0;
      my $has_pos = [or] $d1 > 0, $d2 > 0, $d3 > 0;

      return not ($has_neg and $has_pos);
   }

   sub orientation(\P, \Q, \R --> Int) {
      my \val = (Q[1] - P[1]) × (R[0] - Q[0]) -
                (Q[0] - P[0]) × (R[1] - Q[1]);

      return 0 if val == 0;     # colinear
      return val > 0 ?? 1 !! 2; # clock or counterclock wise
   }

   sub onSegment(\P, \Q, \R --> Bool) {
      Q[0] ≤ max(P[0], R[0]) and Q[0] ≥ min(P[0], R[0]) and
      Q[1] ≤ max(P[1], R[1]) and Q[1] ≥ min(P[0], R[1])
         ?? True !! False
   }

   sub intersect(\A,\B,\C,\D --> Bool) {
      my \o1 = orientation A, C, D;
      my \o2 = orientation B, C, D;
      my \o3 = orientation A, B, C;
      my \o4 = orientation A, B, D;

         o1 != o2 and o3 != o4
      or o1 ==  0 and onSegment A, C, D
      or o2 ==  0 and onSegment B, C, D
      or o3 ==  0 and onSegment A, B, C
      or o4 ==  0 and onSegment A, B, D
         ?? True !! False
   }

   for ^3 {
      { $result = True; last } if
          point-in-triangle A.[$^i], B or
          point-in-triangle B.[$^i], A ;
   }

   unless $result {
      $result = True if
          intersect A.[0], A.[1], B.[0], B.[1] or
          intersect A.[0], A.[1], B.[0], B.[2]
   }

   say "{A.gist} and {B.gist} do{' NOT' unless $result} overlap.";
}

my \DATA = [
   [ [(0,0),(5,0),(0,5)]   ,  [(0,0),(5,0),(0,6)]     ],
   [ [(0,0),(0,5),(5,0)]   ,  [(0,0),(0,5),(5,0)]     ],
   [ [(0,0),(5,0),(0,5)]   ,  [(-10,0),(-5,0),(-1,6)] ],
   [ [(0,0),(5,0),(2.5,5)] ,  [ (0,4),(2.5,-1),(5,4)] ],
   [ [(0,0),(1,1),(0,2)]   ,  [(2,1),(3,0),(3,2)]     ],
   [ [(0,0),(1,1),(0,2)]   ,  [(2,1),(3,-2),(3,4)]    ],
   [ [(0,0),(1,0),(0,1)]   ,  [(1,0),(2,0),(1,1)]     ]
];

if-overlap $_ for DATA ;

```

Output:

```
[(0 0) (5 0) (0 5)] and [(0 0) (5 0) (0 6)] do overlap.
[(0 0) (0 5) (5 0)] and [(0 0) (0 5) (5 0)] do overlap.
[(0 0) (5 0) (0 5)] and [(-10 0) (-5 0) (-1 6)] do NOT overlap.
[(0 0) (5 0) (2.5 5)] and [(0 4) (2.5 -1) (5 4)] do overlap.
[(0 0) (1 1) (0 2)] and [(2 1) (3 0) (3 2)] do NOT overlap.
[(0 0) (1 1) (0 2)] and [(2 1) (3 -2) (3 4)] do NOT overlap.
[(0 0) (1 0) (0 1)] and [(1 0) (2 0) (1 1)] do overlap.
```


[User]
Use these sentences:
"hi there, how are you today? I'd like to present to you the washing machine 9001. You have been nominated to win one of these! Just make sure you don't break it”

Task
:   Search for the last used punctuation in a sentence, and determine its type according to its punctuation.

Output one of these letters
:   "E" (Exclamation!), "Q" (Question?), "S" (Serious.), "N" (Neutral).

Extra
:   Make your code able to determine multiple sentences.

Don't leave any errors!

Other tasks related to string operations:

Metrics

* Array length
* String length
* Copy a string
* Empty string  (assignment)

Counting

* Word frequency
* Letter frequency
* Jewels and stones
* I before E except after C
* Bioinformatics/base count
* Count occurrences of a substring
* Count how many vowels and consonants occur in a string

Remove/replace

* XXXX redacted
* Conjugate a Latin verb
* Remove vowels from a string
* String interpolation (included)
* Strip block comments
* Strip comments from a string
* Strip a set of characters from a string
* Strip whitespace from a string -- top and tail
* Strip control codes and extended characters from a string

Anagrams/Derangements/shuffling

* Word wheel
* ABC problem
* Sattolo cycle
* Knuth shuffle
* Ordered words
* Superpermutation minimisation
* Textonyms (using a phone text pad)
* Anagrams
* Anagrams/Deranged anagrams
* Permutations/Derangements

Find/Search/Determine

* ABC words
* Odd words
* Word ladder
* Semordnilap
* Word search
* Wordiff  (game)
* String matching
* Tea cup rim text
* Alternade words
* Changeable words
* State name puzzle
* String comparison
* Unique characters
* Unique characters in each string
* Extract file extension
* Levenshtein distance
* Palindrome detection
* Common list elements
* Longest common suffix
* Longest common prefix
* Compare a list of strings
* Longest common substring
* Find common directory path
* Words from neighbour ones
* Change e letters to i in words
* Non-continuous subsequences
* Longest common subsequence
* Longest palindromic substrings
* Longest increasing subsequence
* Words containing "the" substring
* Sum of the digits of n is substring of n
* Determine if a string is numeric
* Determine if a string is collapsible
* Determine if a string is squeezable
* Determine if a string has all unique characters
* Determine if a string has all the same characters
* Longest substrings without repeating characters
* Find words which contains all the vowels
* Find words which contain the most consonants
* Find words which contains more than 3 vowels
* Find words whose first and last three letters are equal
* Find words with alternating vowels and consonants

Formatting

* Substring
* Rep-string
* Word wrap
* String case
* Align columns
* Literals/String
* Repeat a string
* Brace expansion
* Brace expansion using ranges
* Reverse a string
* Phrase reversals
* Comma quibbling
* Special characters
* String concatenation
* Substring/Top and tail
* Commatizing numbers
* Reverse words in a string
* Suffixation of decimal numbers
* Long literals, with continuations
* Numerical and alphabetical suffixes
* Abbreviations, easy
* Abbreviations, simple
* Abbreviations, automatic

Song lyrics/poems/Mad Libs/phrases

* Mad Libs
* Magic 8-ball
* 99 bottles of beer
* The Name Game (a song)
* The Old lady swallowed a fly
* The Twelve Days of Christmas

Tokenize

* Text between
* Tokenize a string
* Word break problem
* Tokenize a string with escaping
* Split a character string based on change of character

Sequences

* Show ASCII table
* De Bruijn sequences
* Summarize and say sequence
* Generate lower case ASCII alphabet

[Assistant]
```
use Lingua::EN::Sentence;

my $paragraph = q:to/PARAGRAPH/;
hi there, how are you today? I'd like to present to you the washing machine
9001. You have been nominated to win one of these! Just make sure you don't
break it

Just because there are punctuation characters like "?", "!" or especially "."
present, it doesn't necessarily mean you have reached the end of a sentence,
does it Mr. Magoo? The syntax highlighting here for Raku isn't the best.
PARAGRAPH

say join "\n\n", $paragraph.&sentences.map: {
    /(<:punct>)$/;
    $_ ~ ' | ' ~ do
    given $0 {
        when '!' { 'E' };
        when '?' { 'Q' };
        when '.' { 'S' };
        default  { 'N' };
    }
}

```

Output:

```
hi there, how are you today? | Q

I'd like to present to you the washing machine
9001. | S

You have been nominated to win one of these! | E

Just make sure you don't
break it | N

Just because there are punctuation characters like "?", "!" or especially "."
present, it doesn't necessarily mean you have reached the end of a sentence,
does it Mr. Magoo? | Q

The syntax highlighting here for Raku isn't the best. | S
```


[User]
Two players have a set of dice each. The first player has nine dice with four faces each, with numbers one to four. The second player has six normal dice with six faces each, each face has the usual numbers from one to six.

They roll their dice and sum the totals of the faces. The player with the highest total wins (it's a draw if the totals are the same). What's the probability of the first player beating the second player?

Later the two players use a different set of dice each. Now the first player has five dice with ten faces each, and the second player has six dice with seven faces each. Now what's the probability of the first player beating the second player?

This task was adapted from the Project Euler Problem n.205:
https://projecteuler.net/problem=205

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2020.08.1

```
sub likelihoods ($roll) {
    my ($dice, $faces) = $roll.comb(/\d+/);
    my @counts;
    @counts[$_]++ for [X+] |(1..$faces,) xx $dice;
    return [@counts[]:p], $faces ** $dice;
}

sub beating-probability ([$roll1, $roll2]) {
    my (@c1, $p1) := likelihoods $roll1;
    my (@c2, $p2) := likelihoods $roll2;
    my $p12 = $p1 * $p2;

    [+] gather for flat @c1 X @c2 -> $p, $q {
	take $p.value * $q.value / $p12 if $p.key > $q.key;
    }
}

# We're using standard DnD notation for dice rolls here.
say .gist, "\t", .raku given beating-probability < 9d4 6d6 >;
say .gist, "\t", .raku given beating-probability < 5d10 6d7 >;

```

Output:

```
0.573144077	<48679795/84934656>
0.64278862872	<3781171969/5882450000>
```

Note that all calculations are in integer and rational arithmetic, so the results in fractional notation are exact.


[User]
Task

Task desciption is taken from Project Euler (https://projecteuler.net/problem=30)

Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.

Even though 15 = 1, it is not expressed as a *sum* (a sum being the summation of a list of two or more numbers), and is therefore not included.

[Assistant]
```
print q:to/EXPANATION/;
Sum of all integers (except 1 for some mysterious reason ¯\_(ツ)_/¯),
for which the individual digits to the nth power sum to itself.
EXPANATION

sub super($i) { $i.trans('0123456789' => '⁰¹²³⁴⁵⁶⁷⁸⁹') }

for 3..8 -> $power {
    print "\nSum of powers of n{super $power}: ";
    my $threshold = 9**$power * $power;
    put .join(' + '), ' = ', .sum with cache
    (2..$threshold).hyper.map: {
        state %p = ^10 .map: { $_ => $_ ** $power };
        $_ if %p{.comb}.sum == $_
    }
}

```

Output:

```
Sum of all integers (except 1 for some mysterious reason ¯\_(ツ)_/¯),
for which the individual digits to the nth power sum to itself.

Sum of powers of n³: 153 + 370 + 371 + 407 = 1301

Sum of powers of n⁴: 1634 + 8208 + 9474 = 19316

Sum of powers of n⁵: 4150 + 4151 + 54748 + 92727 + 93084 + 194979 = 443839

Sum of powers of n⁶: 548834 = 548834

Sum of powers of n⁷: 1741725 + 4210818 + 9800817 + 9926315 + 14459929 = 40139604

Sum of powers of n⁸: 24678050 + 24678051 + 88593477 = 137949578
```


[User]
The digital root,

X
{\displaystyle {\displaystyle X}}
, of a number,

n
{\displaystyle {\displaystyle n}}
, is calculated:

:   find

    X
    {\displaystyle {\displaystyle X}}
     as the sum of the digits of

    n
    {\displaystyle {\displaystyle n}}
:   find a new

    X
    {\displaystyle {\displaystyle X}}
     by summing the digits of

    X
    {\displaystyle {\displaystyle X}}
    , repeating until

    X
    {\displaystyle {\displaystyle X}}
     has only one digit.

The additive persistence is the number of summations required to obtain the single digit.

The task is to calculate the additive persistence and the digital root of a number, e.g.:

:   627615
    {\displaystyle {\displaystyle 627615}}
     has additive persistence

    2
    {\displaystyle {\displaystyle 2}}
     and digital root of

    9
    {\displaystyle {\displaystyle 9}}
    ;
:   39390
    {\displaystyle {\displaystyle 39390}}
     has additive persistence

    2
    {\displaystyle {\displaystyle 2}}
     and digital root of

    6
    {\displaystyle {\displaystyle 6}}
    ;
:   588225
    {\displaystyle {\displaystyle 588225}}
     has additive persistence

    2
    {\displaystyle {\displaystyle 2}}
     and digital root of

    3
    {\displaystyle {\displaystyle 3}}
    ;
:   393900588225
    {\displaystyle {\displaystyle 393900588225}}
     has additive persistence

    2
    {\displaystyle {\displaystyle 2}}
     and digital root of

    9
    {\displaystyle {\displaystyle 9}}
    ;

The digital root may be calculated in bases other than 10.

See

* Casting out nines for this wiki's use of this procedure.
* Digital root/Multiplicative digital root
* Sum digits of an integer
* Digital root sequence on OEIS
* Additive persistence sequence on OEIS
* Iterated digits squaring

[Assistant]
(formerly Perl 6)

```
sub digital-root ($r, :$base = 10) {
    my $root = $r.base($base);
    my $persistence = 0;
    while $root.chars > 1 {
        $root = $root.comb.map({:36($_)}).sum.base($base);
        $persistence++;
    }
    $root, $persistence;
}

my @testnums =
    627615,
    39390,
    588225,
    393900588225,
    58142718981673030403681039458302204471300738980834668522257090844071443085937;

for 10, 8, 16, 36 -> $b {
    for @testnums -> $n {
        printf ":$b\<%s>\ndigital root %s, persistence %s\n\n",
            $n.base($b), digital-root $n, :base($b);
    }
}

```

Output:

```
:10<627615>
digital root 9, persistence 2

:10<39390>
digital root 6, persistence 2

:10<588225>
digital root 3, persistence 2

:10<393900588225>
digital root 9, persistence 2

:10<58142718981673030403681039458302204471300738980834668522257090844071443085937>
digital root 4, persistence 3

:8<2311637>
digital root 2, persistence 3

:8<114736>
digital root 1, persistence 3

:8<2174701>
digital root 1, persistence 3

:8<5566623376301>
digital root 4, persistence 3

:8<10021347156245115014463623107370014314341751427033746320331121536631531505161175135161>
digital root 3, persistence 3

:16<9939F>
digital root F, persistence 2

:16<99DE>
digital root F, persistence 2

:16<8F9C1>
digital root F, persistence 2

:16<5BB64DFCC1>
digital root F, persistence 2

:16<808B9CDCA526832679323BE018CC70FA62E1BF3341B251AF666B345389F4BA71>
digital root 7, persistence 3

:36<DG9R>
digital root U, persistence 2

:36<UE6>
digital root F, persistence 2

:36<CLVL>
digital root F, persistence 2

:36<50YE8N29>
digital root P, persistence 2

:36<37C71GOYNYJ25M3JTQQVR0FXUK0W9QM71C1LVNCBWNRVNOJYPD>
digital root H, persistence 3
```

Or if you are more inclined to the functional programming persuasion, you can use the … sequence operator to calculate the values without side effects:

```
sub digital-root ($r, :$base = 10) {
    my &sum = { .comb.map({:36($_)}).sum.base($base) }

    return .[*-1], .elems-1
        given $r.base($base), &sum … { .chars == 1 }
}

```

Output same as above.


[User]
The multiplicative digital root (MDR) and multiplicative persistence (MP) of a number,

n
{\displaystyle {\displaystyle n}}
, is calculated rather like the Digital root except digits are multiplied instead of being added:

1. Set

   m
   {\displaystyle {\displaystyle m}}
    to

   n
   {\displaystyle {\displaystyle n}}
    and

   i
   {\displaystyle {\displaystyle i}}
    to

   0
   {\displaystyle {\displaystyle 0}}
   .
2. While

   m
   {\displaystyle {\displaystyle m}}
    has more than one digit:
   * Find a replacement

     m
     {\displaystyle {\displaystyle m}}
      as the multiplication of the digits of the current value of

     m
     {\displaystyle {\displaystyle m}}
     .
   * Increment

     i
     {\displaystyle {\displaystyle i}}
     .
3. Return

   i
   {\displaystyle {\displaystyle i}}
    (= MP) and

   m
   {\displaystyle {\displaystyle m}}
    (= MDR)

Task

* Tabulate the MP and MDR of the numbers 123321, 7739, 893, 899998
* Tabulate MDR versus the first five numbers having that MDR, something like:

```
MDR: [n0..n4]
===  ========
  0: [0, 10, 20, 25, 30]
  1: [1, 11, 111, 1111, 11111]
  2: [2, 12, 21, 26, 34]
  3: [3, 13, 31, 113, 131]
  4: [4, 14, 22, 27, 39]
  5: [5, 15, 35, 51, 53]
  6: [6, 16, 23, 28, 32]
  7: [7, 17, 71, 117, 171]
  8: [8, 18, 24, 29, 36]
  9: [9, 19, 33, 91, 119]

```

Show all output on this page.

Similar

The Product of decimal digits of n page was redirected here, and had the following description

```
Find the product of the decimal digits of a positive integer   n,   where n <= 100

```

The three existing entries for Phix, REXX, and Ring have been moved here, under ===Similar=== headings, feel free to match or ignore them.

References

* Multiplicative Digital Root on Wolfram Mathworld.
* Multiplicative digital root on The On-Line Encyclopedia of Integer Sequences.
* What's special about 277777788888899? - Numberphile video

[Assistant]
(formerly Perl 6)

```
sub multiplicative-digital-root(Int $n) {
    return .elems - 1, .[.end]
        given cache($n, {[*] .comb} ... *.chars == 1)
}

for 123321, 7739, 893, 899998 {
    say "$_: ", .&multiplicative-digital-root;
}

for ^10 -> $d {
    say "$d : ", .[^5]
        given (1..*).grep: *.&multiplicative-digital-root[1] == $d;
}

```

Output:

```
123321: 3 8
7739: 3 8
893: 3 2
899998: 2 0
0 : 10 20 25 30 40
1 : 1 11 111 1111 11111
2 : 2 12 21 26 34
3 : 3 13 31 113 131
4 : 4 14 22 27 39
5 : 5 15 35 51 53
6 : 6 16 23 28 32
7 : 7 17 71 117 171
8 : 8 18 24 29 36
9 : 9 19 33 91 119
```


[User]
This task has been clarified. Its programming examples are in need of review to ensure that they still fit the requirements of the task.

**Dijkstra's algorithm**, conceived by Dutch computer scientist Edsger Dijkstra in 1956 and published in 1959, is a graph search algorithm that solves the single-source shortest path problem for a graph with non-negative edge path costs, producing a shortest path tree.

This algorithm is often used in routing and as a subroutine in other graph algorithms.

For a given source vertex (node) in the graph, the algorithm finds the path with lowest cost (i.e. the shortest path) between that vertex and every other vertex.

For instance

If the vertices of the graph represent cities and edge path costs represent driving distances between pairs of cities connected by a direct road,   Dijkstra's algorithm can be used to find the shortest route between one city and all other cities.

As a result, the shortest path first is widely used in network routing protocols, most notably:

:   :   * IS-IS   (Intermediate System to Intermediate System)   and
        * OSPF   (Open Shortest Path First).

Important note

The inputs to Dijkstra's algorithm are a directed and weighted graph consisting of **2** or more nodes, generally represented by:

:   :   * an adjacency matrix or list,   and
        * a start node.

A destination node is not specified.

The output is a set of edges depicting the shortest path to each destination node.

An example, starting with

```
                                         a──►b,  cost=7,   lastNode=a
                                         a──►c,  cost=9,   lastNode=a
                                         a──►d,  cost=NA,  lastNode=a
                                         a──►e,  cost=NA,  lastNode=a
                                         a──►f,  cost=14,  lastNode=a

    The lowest cost is    a──►b    so    a──►b    is added to the output.

    There is a connection from   b──►d   so the input is updated to:
                                         a──►c,  cost=9,   lastNode=a
                                         a──►d,  cost=22,  lastNode=b
                                         a──►e,  cost=NA,  lastNode=a
                                         a──►f,  cost=14,  lastNode=a

    The lowest cost is    a──►c    so    a──►c    is added to the output.

    Paths to    d    and    f    are cheaper via    c    so the input is updated to:
                                         a──►d,  cost=20,  lastNode=c
                                         a──►e,  cost=NA,  lastNode=a
                                         a──►f,  cost=11,  lastNode=c

    The lowest cost is    a──►f    so    c──►f    is added to the output.

    The input is updated to:
                                         a──►d,  cost=20,  lastNode=c
                                         a──►e,  cost=NA,  lastNode=a

    The lowest cost is    a──►d    so    c──►d    is added to the output.

    There is a connection from    d──►e    so the input is updated to:
                                         a──►e,  cost=26,  lastNode=d

    Which just leaves adding    d──►e    to the output.

    The output should now be:
                                       [ d──►e
                                         c──►d
                                         c──►f
                                         a──►c
                                         a──►b ]

```

Task

1. Implement a version of Dijkstra's algorithm that outputs a set of edges depicting the shortest path to each reachable node from an origin.
2. Run your program with the following directed graph starting at node    **a**.
3. Write a program which interprets the output from the above and use it to output the shortest path from node    **a**    to nodes    **e**    and  **f**.

:   :   :   :   :   :   :   :   :   Vertices

                                    | Number | Name |
                                    | --- | --- |
                                    | 1 | a |
                                    | 2 | b |
                                    | 3 | c |
                                    | 4 | d |
                                    | 5 | e |
                                    | 6 | f |

Edges

| Start | End | Cost |
| --- | --- | --- |
| a | b | 7 |
| a | c | 9 |
| a | f | 14 |
| b | c | 10 |
| b | d | 15 |
| c | d | 11 |
| c | f | 2 |
| d | e | 6 |
| e | f | 9 |

You can use numbers or names to identify vertices in your program.

See also

* Dijkstra's Algorithm vs. A\* Search vs. Concurrent Dijkstra's Algorithm (youtube)

[Assistant]
(formerly Perl 6)

**Works with**: Rakudo version 2018.03

```
class Graph {
  has (%.edges, %.nodes);

  method new(*@args){
    my (%edges, %nodes);
    for @args {
      %edges{.[0] ~ .[1]} = $_;
      %nodes{.[0]}.push( .[0] ~ .[1] );
      %nodes{.[1]}.push( .[0] ~ .[1] );
    }
    self.bless(edges => %edges, nodes => %nodes);
  }

  method neighbours ($source) {
    my (%neighbours, $edges);
    $edges = self.nodes{$source};
    for @$edges -> $x {
      for self.edges{$x}[0..1] -> $y {
        if $y ne $source {
          %neighbours{$y} = self.edges{$x}
        }
      }
    }
    return %neighbours
  }

  method dijkstra ($source, $dest) {
    my (%node_data, $v, $u);
    my @q = self.nodes.keys;

    for self.nodes.keys {
      %node_data{$_}{'dist'} = Inf;
      %node_data{$_}{'prev'} = '';
    }
    %node_data{$source}{'dist'} = 0;

    while @q {
      # %node_data.perl.say;
      my ($mindist, $idx) =
        @((map {[%node_data{@q[$_]}{'dist'},$_]},^@q).min(*[0]));
      $u = @q[$idx];

      if $mindist eq Inf {
        return ()
      }
      elsif $u eq $dest {
        my @s;
        while %node_data{$u}{'prev'} {
          @s.unshift($u);
          $u = %node_data{$u}{'prev'}
        }
        @s.unshift($source);
        return @s;
      }
      else {
        @q.splice($idx,1);
      }

      for self.neighbours($u).kv -> $v, $edge {
        my $alt = %node_data{$u}{'dist'} + $edge[2];
        if $alt < %node_data{$v}{'dist'} {
          %node_data{$v}{'dist'} = $alt;
          %node_data{$v}{'prev'} = $u
        }
      }
    }
  }
}

my $a = Graph.new([
  ["a", "b",  7],
  ["a", "c",  9],
  ["a", "f", 14],
  ["b", "c", 10],
  ["b", "d", 15],
  ["c", "d", 11],
  ["c", "f",  2],
  ["d", "e",  6],
  ["e", "f",  9]
]).dijkstra('a', 'e').say;

```

Output:

```
[a c f e]
```


[User]
Task

Solve Dinesman's multiple dwelling problem but in a way that most naturally follows the problem statement given below.

Solutions are allowed (but not required) to parse and interpret the problem text, but should remain flexible and should state what changes to the problem text are allowed. Flexibility and ease of expression are valued.

Examples may be be split into "setup", "problem statement", and "output" sections where the ease and naturalness of stating the problem and getting an answer, as well as the ease and flexibility of modifying the problem are the primary concerns.

Example output should be shown here, as well as any comments on the examples flexibility.

The problem

Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment house that contains only five floors.

:   :   * Baker does not live on the top floor.
        * Cooper does not live on the bottom floor.
        * Fletcher does not live on either the top or the bottom floor.
        * Miller lives on a higher floor than does Cooper.
        * Smith does not live on a floor adjacent to Fletcher's.
        * Fletcher does not live on a floor adjacent to Cooper's.

*Where does everyone live?*

[Assistant]
(formerly Perl 6)

### By parsing the problem

**Translation of**: Perl

```
use MONKEY-SEE-NO-EVAL;

sub parse_and_solve ($text) {
    my %ids;
    my $expr = (grammar {
        state $c = 0;
        rule TOP { <fact>+ { make join ' && ', $<fact>>>.made } }

        rule fact { <name> (not)? <position>
                    { make sprintf $<position>.made.fmt($0 ??  "!(%s)" !! "%s"),
                                   $<name>.made }
        }
        rule position {
            || on bottom             { make "\@f[%s] == 1"                            }
            || on top                { make "\@f[%s] == +\@f"                         }
            || lower than <name>     { make "\@f[%s] < \@f[{$<name>.made}]"           }
            || higher than <name>    { make "\@f[%s] > \@f[{$<name>.made}]"           }
            || directly below <name> { make "\@f[%s] == \@f[{$<name>.made}] - 1"      }
            || directly above <name> { make "\@f[%s] == \@f[{$<name>.made}] + 1"      }
            || adjacent to <name>    { make "\@f[%s] == \@f[{$<name>.made}] + (-1|1)" }
            || on <ordinal>          { make "\@f[%s] == {$<ordinal>.made}"            }
            || { note "Failed to parse line " ~ +$/.prematch.comb(/^^/); exit 1; }
        }

        token name    { :i <[a..z]>+              { make %ids{~$/} //= $c++ } }
        token ordinal { [1st | 2nd | 3rd | \d+th] { make +$/.match(/(\d+)/)[0]     } }
    }).parse($text).made;

    EVAL 'for [1..%ids.elems].permutations -> @f {
              say %ids.kv.map({ "$^a=@f[$^b]" }) if (' ~ $expr ~ ');
          }'
}

parse_and_solve Q:to/END/;
    Baker not on top
    Cooper not on bottom
    Fletcher not on top
    Fletcher not on bottom
    Miller higher than Cooper
    Smith not adjacent to Fletcher
    Fletcher not adjacent to Cooper
    END

```

Supports the same grammar for the problem statement, as the Perl solution.

Output:

```
Baker=3 Cooper=2 Fletcher=4 Miller=5 Smith=1

```

### Simple solution

**Works with**: rakudo version 2015-11-15

```
# Contains only five floors. 5! = 120 permutations.
for (flat (1..5).permutations) -> $b, $c, $f, $m, $s {
    say "Baker=$b Cooper=$c Fletcher=$f Miller=$m Smith=$s"
        if  $b != 5         # Baker    !live  on top floor.
        and $c != 1         # Cooper   !live  on bottom floor.
        and $f != 1|5       # Fletcher !live  on top or the bottom floor.
        and $m  > $c        # Miller    lives on a higher floor than Cooper.
        and $s != $f-1|$f+1 # Smith    !live  adjacent to Fletcher
        and $f != $c-1|$c+1 # Fletcher !live  adjacent to Cooper
    ;
}

```

Adding more people and floors requires changing the list that's being used for the permutations, adding a variable for the new person, a piece of output in the string and finally to adjust all mentions of the "top" floor.
Adjusting to different rules requires changing the multi-line if statement in the loop.

Output:

```
Baker=3 Cooper=2 Fletcher=4 Miller=5 Smith=1
```


[User]
The dining philosophers problem illustrates non-composability of low-level synchronization primitives like semaphores. It is a modification of a problem posed by Edsger Dijkstra.

Five philosophers, Aristotle, Kant, Spinoza, Marx, and Russell (the tasks) spend their time thinking and eating spaghetti. They eat at a round table with five individual seats. For eating each philosopher needs two forks (the resources). There are five forks on the table, one left and one right of each seat. When a philosopher cannot grab both forks it sits and waits. Eating takes random time, then the philosopher puts the forks down and leaves the dining room. After spending some random time thinking about the nature of the universe, he again becomes hungry, and the circle repeats itself.

It can be observed that a straightforward solution, when forks are implemented by semaphores, is exposed to deadlock. There exist two deadlock states when all five philosophers are sitting at the table holding one fork each. One deadlock state is when each philosopher has grabbed the fork left of him, and another is when each has the fork on his right.

There are many solutions of the problem, program at least one, and explain how the deadlock is prevented.

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2015-09-09

We use locking mutexes for the forks, and a lollipop to keep the last person who finished eating from getting hungry until the next person finishes eating, which prevents a cycle of dependency from forming. The algorithm should scale to many philosophers, and no philosopher need be singled out to be left-handed, so it's fair in that sense.

```
class Fork {
    has $!lock = Lock.new;
    method grab($who, $which) {
	say "$who grabbing $which fork";
	$!lock.lock;
    }
    method drop($who, $which) {
	say "$who dropping $which fork";
	$!lock.unlock;
    }
}

class Lollipop {
    has $!channel = Channel.new;
    method mine($who) { $!channel.send($who) }
    method yours { $!channel.receive }
}

sub dally($sec) { sleep 0.01 + rand * $sec }

sub MAIN(*@names) {
    @names ||= <Aristotle Kant Spinoza Marx Russell>;

    my @lfork = Fork.new xx @names;
    my @rfork = @lfork.rotate;

    my $lollipop = Lollipop.new;
    start { $lollipop.yours; }

    my @philosophers = do for flat @names Z @lfork Z @rfork -> $n, $l, $r {
	start {
	    sleep 1 + rand*4;
	    loop {
		$l.grab($n,'left');
		dally 1;  # give opportunity for deadlock
		$r.grab($n,'right');
		say "$n eating";
		dally 10;
		$l.drop($n,'left');
		$r.drop($n,'right');

		$lollipop.mine($n);
		sleep 1;  # lick at least once
		say "$n lost lollipop to $lollipop.yours(), now digesting";

		dally 20;
	    }
	}
    }
    sink await @philosophers;
}

```

Output:

```
Aristotle grabbing left fork
Aristotle grabbing right fork
Aristotle eating
Marx grabbing left fork
Marx grabbing right fork
Marx eating
Spinoza grabbing left fork
Aristotle dropping left fork
Aristotle dropping right fork
Russell grabbing left fork
Kant grabbing left fork
Kant grabbing right fork
Spinoza grabbing right fork
Marx dropping left fork
Marx dropping right fork
Aristotle lost lollipop to Marx, now digesting
Spinoza eating
Spinoza dropping left fork
Spinoza dropping right fork
Kant eating
Russell grabbing right fork
Russell eating
Marx lost lollipop to Spinoza, now digesting
Kant dropping left fork
Kant dropping right fork
Spinoza lost lollipop to Kant, now digesting
Russell dropping left fork
Russell dropping right fork
Kant lost lollipop to Russell, now digesting
Spinoza grabbing left fork
Spinoza grabbing right fork
Spinoza eating
Aristotle grabbing left fork
Aristotle grabbing right fork
Aristotle eating
Aristotle dropping left fork
Aristotle dropping right fork
Russell lost lollipop to Aristotle, now digesting
Spinoza dropping left fork
Spinoza dropping right fork
Aristotle lost lollipop to Spinoza, now digesting
Russell grabbing left fork
Marx grabbing left fork
Russell grabbing right fork
Russell eating
Marx grabbing right fork
Kant grabbing left fork
Kant grabbing right fork
Kant eating
Russell dropping left fork
Russell dropping right fork
Spinoza lost lollipop to Russell, now digesting
Marx eating
Spinoza grabbing left fork
Kant dropping left fork
Kant dropping right fork
Russell lost lollipop to Kant, now digesting
Spinoza grabbing right fork
^C
```


[User]
A **Disarium number** is an integer where the sum of each digit raised to the power of its position in the number, is equal to the number.

E.G.

**135** is a **Disarium number**:

11 + 32 + 53 == 1 + 9 + 125 == 135

There are a finite number of **Disarium numbers**.

Task

* Find and display the first 18 **Disarium numbers**.

Stretch

* Find and display all 20 **Disarium numbers**.

See also

* Geeks for Geeks - Disarium numbers * OEIS:A032799 - Numbers n such that n equals the sum of its digits raised to the consecutive powers (1,2,3,...) * Related task: Narcissistic decimal number * Related task: Own digits power sum *Which seems to be the same task as Narcissistic decimal number...*

[Assistant]
Not an efficient algorithm. First 18 in less than 1/4 second. 19th in around 45 seconds. Pretty much unusable for the 20th.

```
my $disarium = (^∞).hyper.map: { $_ if $_ == sum .polymod(10 xx *).reverse Z** 1..* };

put $disarium[^18];
put $disarium[18];

```

Output:

```
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
2646798
```


[User]
Task

Convert a given date from the   Gregorian calendar   to the   Discordian calendar.

[Assistant]
(formerly Perl 6)

**Works with**: rakudo version 2015-11-04

```
my @seasons = << Chaos Discord Confusion Bureaucracy 'The Aftermath' >>;
my @days = << Sweetmorn Boomtime Pungenday Prickle-Prickle 'Setting Orange' >>;
sub ordinal ( Int $n ) { $n ~ ( $n % 100 == 11|12|13
    ?? 'th' !! < th st nd rd th th th th th th >[$n % 10] ) }

sub ddate ( Str $ymd ) {
    my $d = DateTime.new: "{$ymd}T00:00:00Z" or die;

    my $yold = 'in the YOLD ' ~ $d.year + 1166;

    my $day_of_year0 = $d.day-of-year - 1;

    if $d.is-leap-year {
        return "St. Tib's Day, $yold" if $d.month == 2 and $d.day == 29;
        $day_of_year0-- if $day_of_year0 >= 60; # Compensate for St. Tib's Day
    }

    my $weekday    = @days[    $day_of_year0 mod  5     ];
    my $season     = @seasons[ $day_of_year0 div 73     ];
    my $season_day = ordinal(  $day_of_year0 mod 73 + 1 );

    return "$weekday, the $season_day day of $season $yold";
}

say "$_ is {.&ddate}" for < 2010-07-22 2012-02-28 2012-02-29 2012-03-01 >;

```

Output:

```
2010-07-22 is Pungenday, the 57th day of Confusion in the YOLD 3176
2012-02-28 is Prickle-Prickle, the 59th day of Chaos in the YOLD 3178
2012-02-29 is St. Tib's Day, in the YOLD 3178
2012-03-01 is Setting Orange, the 60th day of Chaos in the YOLD 3178

```