Rosetta Code

Cheryl's birthday: Difference between revisions

Page Discussion

Cheryl's birthday (view source)

Revision as of 23:47, 4 March 2024

10,926 bytes added ,  3 months ago
Added FreeBASIC
m (→‎{{header|Wren}}: Changed to Wren S/H)
(Added FreeBASIC)
(4 intermediate revisions by 3 users not shown)
Line 236:
JULY, 16
</pre>
 
=={{header|ALGOL 68}}==
{{works with|ALGOL 68G|Any - tested with release 2.8.3.win32}}
<syntaxhighlight lang="algol68">
BEGIN # Cheryl's birthday puzzle #
 
[ 1 : 4, 1 : 6 ]INT dates # non-zero indicates a possible date #
:= ( ( 0, 15, 16, 0, 0, 19 ) # may #
, ( 0, 0, 0, 17, 18, 0 ) # june #
, ( 14, 0, 16, 0, 0, 0 ) # july #
, ( 14, 15, 0, 17, 0, 0 ) # august #
);
[]STRING month name = ( "May", "June", "July", "August" );
print( ( "Cheryl tells Albert the month and Bernard the day", newline ) );
print( ( "Albert doesn't know the date and knows Bernard doesn't either", newline ) );
FOR d TO 2 UPB dates DO # elimiate the months with unique days #
INT day count := 0;
INT day := 0;
INT month := 0;
FOR m TO 1 UPB dates DO
IF dates[ m, d ] /= 0 THEN
day count +:= 1;
day := dates[ m, d ];
month := m
FI
OD;
IF day count = 1 THEN
print( ( " Eliminating ", month name[ month ], ", ", whole( day, 0 ), "th is unique", newline ) );
FOR p TO 2 UPB dates DO dates[ month, p ] := 0 OD
FI
OD;
print( ( "Bernard now knows the date", newline ) );
FOR d TO 2 UPB dates DO # eliminate the days that aren't unique #
INT day count := 0;
INT day := 0;
INT month := 0;
FOR m TO 1 UPB dates DO
IF dates[ m, d ] /= 0 THEN
day count +:= 1;
day := dates[ m, d ];
month := m
FI
OD;
IF day count > 1 THEN
print( ( " Eliminating ", whole( day, 0 ), "th, it is non-unique", newline ) );
FOR p TO 1 UPB dates DO dates[ p, d ] := 0 OD
FI
OD;
print( ( "Albert now knows the date", newline ) );
FOR m TO 1 UPB dates DO # eliminate months with non-unique days #
INT day count := 0;
INT day := 0;
INT month := 0;
FOR d TO 2 UPB dates DO
IF dates[ m, d ] /= 0 THEN
day count +:= 1;
day := dates[ m, d ];
month := m
FI
OD;
IF day count > 1 THEN
print( ( " Eliminating ", month name[ m ], ", it has multiple days", newline ) );
FOR p TO 2 UPB dates DO dates[ m, p ] := 0 OD
FI
OD;
print( ( "Cheryl's birthday: " ) ); # show the solution(s) #
FOR m TO 1 UPB dates DO
FOR d TO 2 UPB dates DO
IF dates[ m, d ] /= 0 THEN
print( ( " ", month name[ m ], " ", whole( dates[ m, d ], 0 ), "th" ) )
FI
OD
OD;
print( ( newline ) )
END
</syntaxhighlight>
{{out}}
<pre>
Cheryl tells Albert the month and Bernard the day
Albert doesn't know the date and knows Bernard doesn't either
Eliminating June, 18th is unique
Eliminating May, 19th is unique
Bernard now knows the date
Eliminating 14th, it is non-unique
Albert now knows the date
Eliminating August, it has multiple days
Cheryl's birthday: July 16th
</pre>
 
=={{header|AppleScript}}==
<syntaxhighlight lang="applescript">use AppleScript version "2.4"
Line 1,485 ⟶ 1,574:
July 16
</pre>
 
=={{header|FreeBASIC}}==
{{trans|ALGOL 68}}
<syntaxhighlight lang="vbnet">Dim As Integer i, j, contarDias, dia, mes
Dim fechas(1 To 4, 1 To 6) As Integer => {{0, 15, 16, 0, 0, 19}, {0, 0, 0, 17, 18, 0}, {14, 0, 16, 0, 0, 0}, {14, 15, 0, 17, 0, 0}}
Dim nombreMes(1 To 4) As String => {"May", "June", "July", "August"}
 
Print "Cheryl tells Albert the month and Bernard the day"
Print "Albert doesn't know the date and knows Bernard doesn't either"
 
' elimiate the months with unique days
For i = 1 To 6
contarDias = 0
dia = 0
mes = 0
For j = 1 To 4
If fechas(j, i) <> 0 Then
contarDias += 1
dia = fechas(j, i)
mes = j
End If
Next j
If contarDias = 1 Then
Print " Eliminating "; nombreMes(mes); ", "; Str(dia); "th is unique"
For j = 1 To 6
fechas(mes, j) = 0
Next j
End If
Next i
 
Print "Bernard now knows the date"
 
' eliminate the days that aren't unique
For i = 1 To 6
contarDias = 0
dia = 0
mes = 0
For j = 1 To 4
If fechas(j, i) <> 0 Then
contarDias += 1
dia = fechas(j, i)
mes = j
End If
Next j
If contarDias > 1 Then
Print " Eliminating "; Str(dia); "th, it is non-unique"
For j = 1 To 4
fechas(j, i) = 0
Next j
End If
Next i
 
Print "Albert now knows the date"
 
' eliminate months with non-unique days
For i = 1 To 4
contarDias = 0
dia = 0
mes = 0
For j = 1 To 6
If fechas(i, j) <> 0 Then
contarDias += 1
dia = fechas(i, j)
mes = i
End If
Next j
If contarDias > 1 Then
Print " Eliminating "; nombreMes(i); ", it has multiple days"
For j = 1 To 6
fechas(i, j) = 0
Next j
End If
Next i
 
Print "Cheryl's birthday: ";
For i = 1 To 4
For j = 1 To 6
If fechas(i, j) <> 0 Then
Print " "; nombreMes(i); " "; Str(fechas(i, j)); "th"
End If
Next j
Next i
 
Sleep</syntaxhighlight>
{{out}}
<pre>Same as ALGOL 68 entry.</pre>
 
=={{header|Go}}==
<syntaxhighlight lang="go">package main
Line 1,587 ⟶ 1,763:
Cheryl's birthday is July 16
</pre>
=={{header|Fortran}}==
{{trans|C}}
<syntaxhighlight lang="fortran">
program code_translation
implicit none
character(len=3), dimension(13) :: months = ["ERR", "Jan", "Feb", "Mar", "Apr", "May",&
"Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
type :: Date
integer :: month, day
logical :: active
end type Date
type(Date), dimension(10) :: dates = [Date(5,15,.true.), Date(5,16,.true.), Date(5,19,.true.), &
Date(6,17,.true.), Date(6,18,.true.), &
Date(7,14,.true.), Date(7,16,.true.), &
Date(8,14,.true.), Date(8,15,.true.), Date(8,17,.true.)]
integer, parameter :: UPPER_BOUND = size(dates)
write(*,*) 'possible dates: [[May 15] [May 16] [May 19] [June 17] [June 18] [July 14] [July 16] [August 14] [August 15] [August &
17]]'
write(*,*)
write(*,*) '(1) Albert: I don''t know when Cheryl''s birthday is, but I know that Bernard does not know too.'
write(*,*) ' -> meaning: the month cannot have a unique day'
write(*,*) ' -> remaining: [[July 14] [July 16] [August 14] [August 15] [August 17]] '
write(*,*)
write(*,*) "(2) Bernard: At first I don't know when Cheryl's birthday is, but I know now."
write(*,*) ' -> meaning: the day must be unique'
write(*,*) ' -> remaining: [[July 16] [August 15] [August 17]] '
write(*,*)
write(*,*) '(3) Albert: Then I also know when Cheryl''s birthday is.'
write(*,*) ' -> meaning: the month must be unique'
write(*,*) ' -> remaining: [[July 16]] '
 
call printRemaining()
! the month cannot have a unique day
call firstPass()
call printRemaining()
! the day must now be unique
call secondPass()
call printRemaining()
! the month must now be unique
call thirdPass()
call printAnswer()
 
contains
 
subroutine printRemaining()
integer :: i, c
do i = 1, UPPER_BOUND
if (dates(i)%active) then
write(*,'(a,1x,i0,1x)',advance="no") months(dates(i)%month+1),dates(i)%day
c = c + 1
end if
end do
!
write(*,*)
end subroutine printRemaining
 
subroutine printAnswer()
integer :: i
write(*,'(a)',advance ='no') 'Cheryl''s birtday is on '
do i = 1, UPPER_BOUND
if (dates(i)%active) then
write(*,'(a,1a1,i0)') trim(months(dates(i)%month+1)), ",", dates(i)%day
end if
end do
end subroutine printAnswer
 
subroutine firstPass()
! the month cannot have a unique day
integer :: i, j, c
do i = 1, UPPER_BOUND
c = 0
do j = 1, UPPER_BOUND
if (dates(j)%day == dates(i)%day) then
c = c + 1
end if
end do
if (c == 1) then
do j = 1, UPPER_BOUND
if (.not. dates(j)%active) cycle
if (dates(j)%month == dates(i)%month) then
dates(j)%active = .false.
end if
end do
end if
end do
end subroutine firstPass
 
subroutine secondPass()
! the day must now be unique
integer :: i, j, c
do i = 1, UPPER_BOUND
if (.not. dates(i)%active) cycle
c = 0
do j = 1, UPPER_BOUND
if (.not. dates(j)%active) cycle
if (dates(j)%day == dates(i)%day) then
c = c + 1
end if
end do
if (c > 1) then
do j = 1, UPPER_BOUND
if (.not. dates(j)%active) cycle
if (dates(j)%day == dates(i)%day) then
dates(j)%active = .false.
end if
end do
end if
end do
end subroutine secondPass
 
subroutine thirdPass()
! the month must now be unique
integer :: i, j, c
do i = 1, UPPER_BOUND
if (.not. dates(i)%active) cycle
c = 0
do j = 1, UPPER_BOUND
if (.not. dates(j)%active) cycle
if (dates(j)%month == dates(i)%month) then
c = c + 1
end if
end do
if (c > 1) then
do j = 1, UPPER_BOUND
if (.not. dates(j)%active) cycle
if (dates(j)%month == dates(i)%month) then
dates(j)%active = .false.
end if
end do
end if
end do
end subroutine thirdPass
 
end program code_translation
</syntaxhighlight>
{{out}}
<pre>
possible dates: [[May 15] [May 16] [May 19] [June 17] [June 18] [July 14] [July 16] [August 14] [August 15] [August 17]]
 
(1) Albert: I don't know when Cheryl's birthday is, but I know that Bernard does not know too.
-> meaning: the month cannot have a unique day
-> remaining: [[July 14] [July 16] [August 14] [August 15] [August 17]]
 
(2) Bernard: At first I don't know when Cheryl's birthday is, but I know now.
-> meaning: the day must be unique
-> remaining: [[July 16] [August 15] [August 17]]
 
(3) Albert: Then I also know when Cheryl's birthday is.
-> meaning: the month must be unique
-> remaining: [[July 16]]
May 15 May 16 May 19 Jun 17 Jun 18 Jul 14 Jul 16 Aug 14 Aug 15 Aug 17
Jul 14 Jul 16 Aug 14 Aug 15 Aug 17
Jul 16 Aug 15 Aug 17
Cheryl's birthday is on Jul,16
</Pre>
 
=={{header|Groovy}}==
{{trans|Java}}
Line 3,171 ⟶ 3,503:
For x = 29 To 0 Step -1 : @d(x) = Pop() : Next
 
Push Dup("ERR"), Dup("Jan"), Dup("Feb"), Dup("Mar"), Dup("Apr"), Dup("May")
Push Dup("Jun"), Dup("Jul"), Dup("Aug"), Dup("Sep"), Dup("Oct"), Dup("Nov"), Dup("Dec")
For x = 12 To 0 Step -1 : @m(x) = Pop() : Next
 
Line 3,288 ⟶ 3,620:
 
0 OK, 0:657</pre>
 
=={{header|VBA}}==
<syntaxhighlight lang="vb">Private Sub exclude_unique_days(w As Collection)
Jjuanhdez
2,130

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/353649...361233"