Rosetta Code

Divide a rectangle into a number of unequal triangles: Difference between revisions

Page Discussion

Divide a rectangle into a number of unequal triangles (view source)

Revision as of 01:14, 17 April 2024

5,584 bytes added ,  1 month ago
Added FreeBASIC
(Added Perl)
(Added FreeBASIC)
 
(7 intermediate revisions by 4 users not shown)
Line 12:
* Give a sample of sets of triangles produced from running the algorithm, on this page.
 
 
=={{header|FreeBASIC}}==
{{trans|WRen}}
<syntaxhighlight lang="vbnet">Randomize Timer
 
Function MINIMUM(arr() As Single) As Single
Dim As Single minVal = arr(Lbound(arr))
For i As Integer = Lbound(arr) To Ubound(arr)
If arr(i) < minVal Then minVal = arr(i)
Next i
Return minVal
End Function
Function MAXIMUM(arr() As Single) As Single
Dim As Single maxVal = arr(Lbound(arr))
For i As Integer = Lbound(arr) To Ubound(arr)
If arr(i) > maxVal Then maxVal = arr(i)
Next i
Return maxVal
End Function
 
Sub pointsOfRect(w As Integer, h As Integer, pts() As Single)
Redim As Single pts(1 To 4, 1 To 2)
pts(1, 1) = 0: pts(1, 2) = 0
pts(2, 1) = h: pts(2, 2) = 0
pts(3, 1) = h: pts(3, 2) = w
pts(4, 1) = 0: pts(4, 2) = w
End Sub
 
Function dist(p1() As Single, p2() As Single) As Single
Dim As Single dx = p2(1) - p1(1)
Dim As Single dy = p2(2) - p1(2)
Return Sqr(dx * dx + dy * dy)
End Function
 
Function area(tris() As Single, triIndex As Integer) As Single
Dim As Single aPoint(1 To 2)
Dim As Single bPoint(1 To 2)
aPoint(1) = tris(triIndex, 2, 1): aPoint(2) = tris(triIndex, 2, 2)
bPoint(1) = tris(triIndex, 1, 1): bPoint(2) = tris(triIndex, 1, 2)
Dim a As Single = dist(aPoint(), bPoint())
bPoint(1) = tris(triIndex, 3, 1): bPoint(2) = tris(triIndex, 3, 2)
Dim b As Single = dist(aPoint(), bPoint())
aPoint(1) = tris(triIndex, 1, 1): aPoint(2) = tris(triIndex, 1, 2)
Dim c As Single = dist(aPoint(), bPoint())
Dim s As Single = (a + b + c) * 0.5
Return Sqr(s * (s - a) * (s - b) * (s - c))
End Function
 
Sub divideRectIntoTris(w As Integer, h As Integer, n As Uinteger, tris() As Single)
Dim As Uinteger i, j, k
If n < 3 Then Print "'n' must be an integer >= 3.": Exit Sub 'END
Dim As Single pts(1 To 4, 1 To 2)
pointsOfRect(w, h, pts())
Dim As Single upper(1 To 3, 1 To 2)
For i = 1 To 3
For j = 1 To 2
upper(i, j) = pts(i, j)
Next j
Next i
Redim As Single tris(1 To n, 1 To 3, 1 To 2)
For i = 1 To 3
For j = 1 To 2
tris(1, i, j) = upper(i, j)
Next j
Next i
Dim As Single xs(1 To n)
xs(n) = w
Dim As Single lens(1 To n - 1)
Do
For i = 1 To n - 2
xs(i) = Rnd * w
Next i
' Sort xs
For i = 1 To n - 1
For j = i + 1 To n
If xs(i) > xs(j) Then Swap xs(i), xs(j)
Next j
Next i
For i = 1 To n - 1
lens(i) = xs(i + 1) - xs(i)
Next i
Loop Until MINIMUM(lens()) <> 0
For i = 1 To n - 1
Dim As Single tri(1 To 3, 1 To 2)
tri(1, 1) = xs(i): tri(1, 2) = 0
tri(2, 1) = pts(3, 1): tri(2, 2) = pts(3, 2)
tri(3, 1) = xs(i + 1): tri(3, 2) = 0
For j = 1 To 3
For k = 1 To 2
tris(i + 1, j, k) = tri(j, k)
Next k
Next j
Next i
End Sub
 
Dim As Single dims(1 To 2, 1 To 3)
dims(1, 1) = 20: dims(1, 2) = 10: dims(1, 3) = 4
dims(2, 1) = 30: dims(2, 2) = 20: dims(2, 3) = 8
Dim As Integer i, j, triIndex
Dim As Single w, h, n
For dimIndex As Uinteger = 1 To 2
w = dims(dimIndex, 1)
h = dims(dimIndex, 2)
n = dims(dimIndex, 3)
Print "A rectangle with a lower left vertex at (0, 0), width"; w; " and height"; h
Print "can be split into the following"; n; " triangles:"
Dim As Single tris(1 To n, 1 To 3, 1 To 2)
divideRectIntoTris(w, h, n, tris())
Dim As Single areas(1 To n)
Dim As Single tri(1 To 3, 1 To 2)
For triIndex = 1 To n
For i = 1 To 3
For j = 1 To 2
tri(i, j) = tris(triIndex, i, j)
Next j
Next i
areas(triIndex) = area(tris(), triIndex)
Next triIndex
If MINIMUM(areas()) <> MAXIMUM(areas()) Then
For triIndex = 1 To n
Print "[";
For i = 1 To 3
Print "[";
For j = 1 To 2
tri(i, j) = tris(triIndex, i, j)
Print Str(tri(i, j)); ",";
Next j
Print Chr(8); "], ";
Next i
Print Chr(8); Chr(8); "]"
Next triIndex
End If
Print
Next dimIndex
 
Sleep</syntaxhighlight>
{{out}}
<pre>A rectangle with a lower left vertex at (0, 0), width 20 and height 10
can be split into the following 4 triangles:
[[0,0], [10,0], [10,20]]
[[0,0], [10,20], [9.687466,0]]
[[9.687466,0], [10,20], [14.9594,0]]
[[14.9594,0], [10,20], [20,0]]
 
A rectangle with a lower left vertex at (0, 0), width 30 and height 20
can be split into the following 8 triangles:
[[0,0], [20,0], [20,30]]
[[0,0], [20,30], [3.175989,0]]
[[3.175989,0], [20,30], [4.040901,0]]
[[4.040901,0], [20,30], [10.83484,0]]
[[10.83484,0], [20,30], [15.34319,0]]
[[15.34319,0], [20,30], [16.37033,0]]
[[16.37033,0], [20,30], [21.38275,0]]
[[21.38275,0], [20,30], [30,0]]</pre>
 
=={{header|Julia}}==
The `cutrectangle` method creates a new triangle by consuming a previously created triangle by cutting it at a location determined by the ratio of two sequential primes, making for guaranteed noncongruence of all triangles thus made. The Luxor code is for the demo. See also <link>https://lynxview.com/temp/luxor-drawing.png</link>
<langsyntaxhighlight lang="julia">using Colors
using Luxor
using Primes
Line 54 ⟶ 208:
finish()
preview()
</langsyntaxhighlight>{{out}}
<pre>
t = Triangle(Point(200.0, 0.0), Point(150.0, 150.0), Point(105.0, 105.0))
Line 68 ⟶ 222:
 
=={{header|Perl}}==
All triangle vertices lie on the lengths and the corners and their locations are defined by ratios among two sequences with unique numbers. Since the height is the same but with different base for all triangles, none will share the area.
{{trans|Raku}}
<syntaxhighlight lang="perl">use strict;
{{libheader|ntheory}}
<lang perl>use strict;
use warnings;
use feature 'say';
use ntheory 'primes';
use List::Util 'sum';
 
sub UnequalDivider {
my($L,$H,$N) = @_;
die unless $N > 2;
return (0,$H), (0,0), ((2/5)*$L,$H), ($L,0), ($L,$H) if $N == 3;
 
my ($fail,%unique,%ratios,@base,@roof,$bTotal,$rTotal);
my @primes = @{primes( 10*$N )}[0..$N-1];
 
my @base = @primes[ 0 .. $N/2-1];
do {
my @roof = @primes[$N/2 .. $#primes];
my ( $bTotal,fail $rTotal) = ( sum(@base), sum(@roof) )0;
my ($bPartial,$rPartial) %unique = ( shift(@base),%ratios = shift(@roof) );
++$unique{int(rand 2*$N) + 1} while keys %unique < $N;
my @vertices = ([0,$H], [0,0], [($rPartial/$rTotal)*$L,$H]);
my @segments = keys %unique;
@base = @segments[ 0 .. $N/2-1];
@roof = @segments[$N/2 .. $#segments];
($bTotal,$rTotal) = ( sum(@base), sum(@roof) );
++$ratios{$_/$bTotal} for (@base);
for (@roof) { if ( exists($ratios{$_/$rTotal}) ) { $fail = 1 && last } }
} until ( $fail == 0 );
 
my ($bPartial,$rPartial) = ( shift(@base), shift(@roof) );
my @vertices = ([0,$H], [0,0], [($rPartial/$rTotal)*$L,$H]);
 
for (0 .. @base) {
Line 101 ⟶ 263:
 
my @V = UnequalDivider(1000,500,7);
say sprintf( '(%.3f %.3f) 'x3, @{$V[$_]}, @{$V[++$_]}, @{$V[++$_]} ) =~ s/\.000//gr for 0 .. $#@V - 23;</langsyntaxhighlight>
{{out}}
<pre>(0 500) (0 0) (145352.833941 500)
(0 0) (145352.833941 500) (200520 0)
(145352.833941 500) (200520 0) (375529.412 500)
(200520 0) (375529.412 500) (500680 0)
(375529.412 500) (500680 0) (645588.833235 500)
(500680 0) (645588.833235 500) (1000 0)
(645588.833235 500) (1000 0) (1000 500)</pre>
 
=={{header|Phix}}==
Line 117 ⟶ 279:
and penned a wee little interactive visualisation demo of it, that can be run [http://phix.x10.mx/p2js/SpliRT.htm here].
Should you find a way to make it draw similar triangles, shout out and let me know n and canvas size!
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #000080;font-style:italic;">-- demo/rosetta/SpliRT.exw </span>
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
Line 224 ⟶ 386:
<span style="color: #7060A8;">IupClose</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<!--</langsyntaxhighlight>-->
 
=={{header|Python}}==
Line 231 ⟶ 393:
It is assumed that the rectangle has its bottom left coordinate at (0,0) and is not rotated in the coordinate space, meaning that the location of the top-right corner of the rectangle is then enough to define it.
 
<langsyntaxhighlight lang="python">
import random
from typing import List, Union, Tuple
Line 432 ⟶ 594:
print("\nrect_into_top_tri #2")
pp(rect_into_top_tri((2, 1), 4, 10))
</syntaxhighlight>
</lang>
 
{{out}}
Line 462 ⟶ 624:
 
=={{header|Raku}}==
AllThe first triangle verticesbisects liethe overrectangle via the lengthsdiagonal. and cornersThe rest of them all got one vertex at the rectangleorigin and theira locations areside defined by ratios among primeof numbers drawn from twoa descending positive integer sequencessequence.
<syntaxhighlight lang="raku" perl6line># 20220123 Raku programming solution
 
# Proof :
#
# H-----------A---------B-------C-----D---E
# | |
# | |
# | |
# O---------------------------------------L
#
# ▲OEL is unique as its area is the sum of the rest.
#
# and also in terms of area ▲OHA > ▲OAB > ... > ▲ODE
 
sub UnequalDivider (\L,\H,\N where N > 2) {
 
ifmy N\sum = $ = 30 {; returnmy (0,H),\part = $ = (0,0), ((2/5)*L,H),; my @sequence = (L,0N^...1), (L,H); }
 
myloop { @primes = ((2..*).grep:{.is-prime})[^N] ; # for randomness if ▲OHA ~ ▲OEL
sum = @sequence.sum; # increase 1st term
my @base = @primes[0..N/2-1] and my @roof = @primes[N/2..*]; # add .pick(*)
@sequence[0]*L*L/sum == H*H ?? (@sequence[0] +=1) !! last
 
my ($bTotal,$rTotal) = [ @base, @roof ]>>.sum ;
my ($bPartial,$rPartial) = [ @base, @roof ]>>.shift ;
my @vertices = (0,H), (0,0), (($rPartial/$rTotal)*L,H), ;
 
for ^+@base {
@vertices.push: ( ($bPartial/$bTotal)*L , 0 );
if +@base == 1 { # last segment, the rest just by hand
return N %% 2 ?? @vertices.append: (L,H) , (L,0)
!! @vertices.append: (L*(1-@roof[*-1]/$rTotal),H), (L,0), (L,H)
}
($bPartial,$rPartial) <<+=<< [ @base, @roof ]>>.shift ;
@vertices.push: ( ($rPartial/$rTotal)*L , H );
}
 
( [ (0,0), (L,H), (L,0) ], ).Array.append: @sequence.map: -> \chunk {
[ (0,0), (L*part/sum,H), (L*(part+=chunk)/sum,H) ] ;
}
}
 
.say for UnequalDivider(1000,500,7).rotor( 3 => -2 5);</langsyntaxhighlight>
{{out}}
<pre>
([(0 5000) (01000 0500) (145.8333331000 500)0)]
([(0 0) (145.8333330 500) (200400 0)500)]
[((145.8333330 5000) (200400 0500) (375700 500))]
[((2000 0) (375700 500) (900 500 0))]
[((3750 5000) (900 500 0) (645.8333331000 500))]
((500 0) (645.833333 500) (1000 0))
((645.833333 500) (1000 0) (1000 500))
</pre>
 
Line 508 ⟶ 673:
 
This process should ensure that all the triangles are different, albeit the first one is usually much larger than the others. However, to be absolutely sure, we check that the areas of all the triangles are different.
<langsyntaxhighlight ecmascriptlang="wren">import "random" for Random
import "./seq" for Lst
 
Line 576 ⟶ 741:
}
System.print()
}</langsyntaxhighlight>
 
{{out}}
Jjuanhdez
2,130

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/318542...363737"