Data update

Task/Dinesmans-multiple-dwelling-problem/Ada/dinesmans-multiple-dwelling-problem.adb

@@ -0,0 +1,46 @@
+with Ada.Text_IO; use Ada.Text_IO;
+procedure Dinesman is
+   subtype Floor is Positive range 1 .. 5;
+   type People is (Baker, Cooper, Fletcher, Miller, Smith);
+   type Floors is array (People'Range) of Floor;
+   type PtFloors is access all Floors;
+
+   function Constrained (f : PtFloors) return Boolean is begin
+      if f (Baker) /= Floor'Last and
+         f (Cooper) /= Floor'First and
+         Floor'First < f (Fletcher) and f (Fletcher) < Floor'Last and
+         f (Miller) > f (Cooper) and
+         abs (f (Smith) - f (Fletcher)) /= 1 and
+         abs (f (Fletcher) - f (Cooper)) /= 1
+      then return True; end if;
+      return False;
+   end Constrained;
+
+   procedure Solve (list : PtFloors; n : Natural) is
+      procedure Swap (I : People; J : Natural) is
+         temp : constant Floor := list (People'Val (J));
+      begin list (People'Val (J)) := list (I); list (I) := temp;
+      end Swap;
+   begin
+      if n = 1 then
+         if Constrained (list) then
+            for p in People'Range loop
+               Put_Line (p'Img & " on floor " & list (p)'Img);
+            end loop;
+         end if;
+         return;
+      end if;
+      for i in People'First .. People'Val (n - 1) loop
+         Solve (list, n - 1);
+         if n mod 2 = 1 then Swap (People'First, n - 1);
+         else Swap (i, n - 1); end if;
+      end loop;
+   end Solve;
+
+   thefloors : aliased Floors;
+begin
+   for person in People'Range loop
+      thefloors (person) := People'Pos (person) + Floor'First;
+   end loop;
+   Solve (thefloors'Access, Floors'Length);
+end Dinesman;

Task/Dinesmans-multiple-dwelling-problem/Fortran/dinesmans-multiple-dwelling-problem.f

@@ -0,0 +1,96 @@
+program apartment_puzzle
+  implicit none
+  integer :: domains(5,5)  ! domains(person, floor) = 1 if possible
+  integer :: solution(5)
+  logical :: found
+
+  ! Initialize: all assignments possible, solution unassigned
+  domains = 1
+  solution = 0
+
+  ! Apply unary constraints
+  domains(1, 5) = 0  ! Baker not on top
+  domains(2, 1) = 0  ! Cooper not on bottom
+  domains(3, 1) = 0  ! Fletcher not on bottom
+  domains(3, 5) = 0  ! Fletcher not on top
+
+  call solve_csp(domains, solution, 1, found)
+
+  if (found) then
+    print *, "Baker:   ", solution(1)
+    print *, "Cooper:  ", solution(2)
+    print *, "Fletcher:", solution(3)
+    print *, "Miller:  ", solution(4)
+    print *, "Smith:   ", solution(5)
+  else
+    print *, "No solution found"
+  end if
+
+contains
+
+  recursive subroutine solve_csp(dom, sol, person, found)
+    integer, intent(in) :: dom(5,5)
+    integer, intent(inout) :: sol(5)
+    integer, intent(in) :: person
+    logical, intent(out) :: found
+    integer :: floor, new_dom(5,5)
+
+    if (person > 5) then
+      found = check_all_constraints(sol)
+      return
+    end if
+
+    found = .false.
+    do floor = 1, 5
+      if (dom(person, floor) == 0) cycle
+      if (any(sol(1:person-1) == floor)) cycle  ! Floor already taken
+
+      sol(person) = floor
+
+      ! Check constraints so far
+      if (.not. check_partial_constraints(sol, person)) then
+        sol(person) = 0
+        cycle
+      end if
+
+      ! Forward check: propagate constraints
+      new_dom = dom
+      new_dom(:, floor) = 0  ! Remove this floor from remaining
+
+      call solve_csp(new_dom, sol, person + 1, found)
+      if (found) return
+
+      sol(person) = 0
+    end do
+  end subroutine
+
+  function check_partial_constraints(sol, up_to) result(valid)
+    integer, intent(in) :: sol(5), up_to
+    logical :: valid
+
+    valid = .true.
+
+    ! Miller > Cooper (if both assigned)
+    if (up_to >= 4 .and. sol(4) > 0 .and. sol(2) > 0) then
+      if (sol(4) <= sol(2)) valid = .false.
+    end if
+
+    ! Smith not adjacent Fletcher (if both assigned)
+    if (up_to >= 5 .and. sol(5) > 0 .and. sol(3) > 0) then
+      if (abs(sol(5) - sol(3)) == 1) valid = .false.
+    end if
+
+    ! Fletcher not adjacent Cooper (if both assigned)
+    if (up_to >= 3 .and. sol(3) > 0 .and. sol(2) > 0) then
+      if (abs(sol(3) - sol(2)) == 1) valid = .false.
+    end if
+  end function
+
+  function check_all_constraints(sol) result(valid)
+    integer, intent(in) :: sol(5)
+    logical :: valid
+
+    valid = check_partial_constraints(sol, 5)
+  end function
+
+end program

Task/Dinesmans-multiple-dwelling-problem/PowerShell/dinesmans-multiple-dwelling-problem-1.ps1

@@ -0,0 +1,68 @@
+# Floors are numbered 1 (ground) to 5 (top)
+
+# Baker, Cooper, Fletcher, Miller, and Smith live on different floors:
+$statement1 = '$baker  -ne $cooper -and $baker    -ne $fletcher -and $baker    -ne $miller -and
+               $baker  -ne $smith  -and $cooper   -ne $fletcher -and $cooper   -ne $miller -and
+               $cooper -ne $smith  -and $fletcher -ne $miller   -and $fletcher -ne $smith  -and
+               $miller -ne $smith'
+
+# Baker does not live on the top floor:
+$statement2 = '$baker -ne 5'
+
+# Cooper does not live on the bottom floor:
+$statement3 = '$cooper -ne 1'
+
+# Fletcher does not live on either the top or the bottom floor:
+$statement4 = '$fletcher -ne 1 -and $fletcher -ne 5'
+
+# Miller lives on a higher floor than does Cooper:
+$statement5 = '$miller -gt $cooper'
+
+# Smith does not live on a floor adjacent to Fletcher's:
+$statement6 = '[Math]::Abs($smith - $fletcher) -ne 1'
+
+# Fletcher does not live on a floor adjacent to Cooper's:
+$statement7 = '[Math]::Abs($fletcher - $cooper) -ne 1'
+
+for ($baker = 1; $baker -lt 6; $baker++)
+{
+    for ($cooper = 1; $cooper -lt 6; $cooper++)
+    {
+        for ($fletcher = 1; $fletcher -lt 6; $fletcher++)
+        {
+            for ($miller = 1; $miller -lt 6; $miller++)
+            {
+                for ($smith = 1; $smith -lt 6; $smith++)
+                {
+                    if (Invoke-Expression $statement2)
+                    {
+                        if (Invoke-Expression $statement3)
+                        {
+                            if (Invoke-Expression $statement5)
+                            {
+                                if (Invoke-Expression $statement4)
+                                {
+                                    if (Invoke-Expression $statement6)
+                                    {
+                                        if (Invoke-Expression $statement7)
+                                        {
+                                            if (Invoke-Expression $statement1)
+                                            {
+                                                $multipleDwellings = @()
+                                                $multipleDwellings+= [PSCustomObject]@{Name = "Baker"   ; Floor = $baker}
+                                                $multipleDwellings+= [PSCustomObject]@{Name = "Cooper"  ; Floor = $cooper}
+                                                $multipleDwellings+= [PSCustomObject]@{Name = "Fletcher"; Floor = $fletcher}
+                                                $multipleDwellings+= [PSCustomObject]@{Name = "Miller"  ; Floor = $miller}
+                                                $multipleDwellings+= [PSCustomObject]@{Name = "Smith"   ; Floor = $smith}
+                                            }
+                                        }
+                                    }
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        }
+    }
+}

Task/Dinesmans-multiple-dwelling-problem/PowerShell/dinesmans-multiple-dwelling-problem-2.ps1

@@ -0,0 +1 @@
+$multipleDwellings

Task/Dinesmans-multiple-dwelling-problem/PowerShell/dinesmans-multiple-dwelling-problem-3.ps1

@@ -0,0 +1 @@
+$multipleDwellings | Sort-Object -Property Floor -Descending