by Mike
It’s doing my head in trying to figure out the logic of how to play the cards in cribbage. My Visual Basic program is coming along but there’s been some tricky areas to figure out and this bit is proving difficult. The chart shows where I am with it but I can’t help but feel there’s an approach that would be simpler to code.
This section of code is a small but necessary part of my current project to write a Visual Basic program to play the card game cribbage.
I’m rather please with this, though younger brains might be able to come up with something slicker.
Sub HowMany15s(Cards() As Integer, Ncards As Integer, ByRef HowMany As Integer)
'
' How many 15s are there in the supplied cards
' (uses a binary mask to generate all combinations of cards)
'
Dim i, f As Integer
HowMany = 0
For i = 1 To 2 ^ Ncards - 1
f = 0
Select Case Ncards
Case 3
If (i And 1) > 0 Then f = f + Cards(2)
If (i And 2) > 0 Then f = f + Cards(1)
If (i And 4) > 0 Then f = f + Cards(0)
Case 4
If (i And 1) > 0 Then f = f + Cards(3)
If (i And 2) > 0 Then f = f + Cards(2)
If (i And 4) > 0 Then f = f + Cards(1)
If (i And 8) > 0 Then f = f + Cards(0)
Case 5
If (i And 1) > 0 Then f = f + Cards(4)
If (i And 2) > 0 Then f = f + Cards(3)
If (i And 4) > 0 Then f = f + Cards(2)
If (i And 8) > 0 Then f = f + Cards(1)
If (i And 16) > 0 Then f = f + Cards(0)
End Select
If f = 15 Then HowMany = HowMany + 1
Next
End Sub
I’ve re-written my reminder program AGAIN, the one I wrote for work many, many decades ago!
The first re-write was done using Python (see this post), and the second was using Fortran (see this post).
This time I’ve taught myself Visual Basic (well, some of it) using Microsoft Visual Studio. It’s a monster of a system and great fun trying to get to grips with. On the right is a screen shot of the running program (note the garish colours!) and below are the two code files. [Updated 28.3.23 to correct major sorting bug]
I tentatively have another project lined up, to write a program to play cribbage, my other newly discovered interest. It would be a pretty difficult task – watch this blog…..
Back in 2021, for a challenge, I taught myself part of the Python programming language and wrote a program based on the idea of a Fortran program I wrote decades ago. Now, for another challenge, I’ve written the same program – in Fortran! I had to dig out a free compiler from the Internet (Fortran 90). Things have developed and changed since I was a programmer and I have had to learn new things in the language. Back then I think I used Fortran 66 and Fortran 77.
It’s been fun coding in Fortran, again! For the record, I downloaded and used a free product Code::Blocks, which I’ve found to be successful. I also found this YouTube video to explain configuring of Code::Blocks for Fortran.
! ===================================================================
! Program REMINDER
!
! Decades ago I wrote a FORTRAN program to take a file of reminders
! and to display the records in a sorted and pretty format.
! In March 2021, for fun, I wrote a Python version of the program.
! Now, in January 2023, for fun, I have again written a FORTRAN version.
!
! Version 0.1 20-Jan-2023 Start of conversion of the Python code
! Version 1.0 29-Jan-2023 Final version.....?
!
! ===================================================================
program Reminder
use ReminderModule ! All the functions/subroutines are in this module.
implicit none
type (rec_data) ReminderTable(100)
character myfile*100
integer Nreminders
myFile = "C:\Users\Mike\Documents\Documents\MyFortranCode\MyReminderProject\Reminder.dat"
call GetReminderData(myFile,ReminderTable,Nreminders)
call SortList (ReminderTable,Nreminders)
call PrintList(ReminderTable,Nreminders)
end program Reminder
!
!==========================================================
! Module REMINDERMODULE containing all the functions and subroutines.
!==========================================================
module ReminderModule
!
implicit none
type rec_data !Structure to hold the reminder records
character*11 rec_date !reminder date
character*50 rec_event !reminder event
integer rec_numdays !Calculate days between date and today's date
end type rec_data
contains
!============================================================
!Subroutine GETREMINDERDATA to get the reminder records
!Records are of the form dd-mmm-yyyy,"Event description" and are unordered
!============================================================
subroutine GetReminderData(filename,ReminderTable,N)
implicit none
integer mystatus,N,ans,ans_today
character filename*(*), mystatusmessage*200,mydate*11,mytext*50,today*8
character monthchar*3,months*36
integer d,m,y
type (rec_data) ReminderTable(*)
data months/"JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"/
open (unit=1,file=filename,action='read', &
form='formatted',iostat=mystatus,iomsg=mystatusmessage)
if (myStatus /= 0) then
write (*,'(///2a)') "OOPS! ", mystatusmessage
stop
endif
!
! Calculate the number of days between today and a base date
!
call date_and_time(date=today) ! Inbuilt procedure
read(unit=today,fmt='(i4,i2,i2)')y,m,d ! This used to be done using an ENCODE statement!
call getDays(d,m,y,ans_today) !Get the number of days between today and a base date
!
! Get the reminder records
!
N = 0
do
read (unit=1,fmt=*,iostat=mystatus,iomsg=mystatusmessage)mydate,mytext
if (mystatus /= 0) then
exit
else
N=N+1
ReminderTable(N)%rec_date = mydate
ReminderTable(N)%rec_event = mytext
read (unit=mydate,fmt='(i2,1x,a3,1x,i4)')d,monthchar,y ! Get the date components
m = index(months,uppercase(monthchar))/3+1 ! Lookup the month number using the month text
call getDays(d,m,y,ans) !Get the number of days between the date and a base date
ReminderTable(N)%rec_numdays = ans - ans_today !Number of days between date and today's date
end if
end do
close (unit=1)
end subroutine
!============================================================
! Subroutine GETDAYS to calculate the number of days between
! the supplied date and an arbitrary base date (01/01/2000)
!============================================================
subroutine getDays( day,month,year ,ans)
implicit none
integer ans,i,daysPerMonth(1:12),daysPerMonthLeapYear(1:12)
integer day,month,year
data daysPerMonth / 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /
data daysPerMonthLeapYear / 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /
ans=0
do i = 2000, year-1 ! Add up the days in the preceding years of the supplied date
ans=ans +365
if (isLeap(i)) ans=ans + 1
end do
!
do i =1,month-1,1 ! Add up the days in the preceding months in the year of the supplied date
if (isLeap(year)) then
ans = ans + daysPerMonthLeapYear(i)
else
ans=ans + daysPerMonth(i)
end if
end do
!
ans = ans + day - 1 ! Finally add in the number of days (less 1) of the month of the supplied date
!
end subroutine getdays
!=============================================================
! Function ISLEAP to determine if a year is a leap year
!=============================================================
logical function isLeap(Y)
!
integer Y
!
! A leap year is divisible by 400 or, is divisible by 4 but not by 100
!
isLeap = (mod(Y,400) .EQ. 0) .OR. (mod(Y,4) .EQ. 0 .AND. mod(Y,100) .NE. 0)
end function isleap
!
!=============================================================
! Subroutine SORTLIST to sort the data in date order.
!=============================================================
subroutine SortList (ReminderTable,N)
type (rec_data) :: ReminderTable(*),temp
integer :: N,i,j
logical :: Swapped
DO j = N-1, 1, -1
swapped = .FALSE.
DO i = 1, j
IF (ReminderTable(i)%rec_numdays > ReminderTable(i+1)%rec_numdays) THEN
temp = ReminderTable(i)
ReminderTable(i) = ReminderTable(i+1)
ReminderTable(i+1) = temp
swapped = .TRUE.
END IF
END DO
IF (.NOT. swapped) EXIT
END DO
end subroutine
!
!=============================================================
! Function UPPERCASE to convert text to upper case.
!=============================================================
function uppercase(string)
character(len=*), intent(in) :: string
character(len=len(string)) :: uppercase
integer :: j
do j = 1,len(string)
if(string(j:j) >= "a" .and. string(j:j) <= "z") then
uppercase(j:j) = achar(iachar(string(j:j)) - 32)
else
uppercase(j:j) = string(j:j)
end if
end do
end function uppercase
!
!====================================================
! Function PRINTLIST to nicely print the data
!====================================================
subroutine PrintList (ReminderTable,N)
type (rec_data) :: ReminderTable(*)
integer :: N, nDays, i
logical :: tChange
character*16 t1
character*75,parameter :: mySectionSeparator="---------------------------------------------------"
tChange = .TRUE.
write (*,'(/////)')
write (*,'(2x,a)')mySectionSeparator
write (*,'(2x,a)')" Welcome to my FORTRAN Reminder program!"
write (*,'(2x,a)')mySectionSeparator
do i = 1, N
nDays = ReminderTable(i)%rec_numdays
if (tChange .eqv. .TRUE. .and. nDays > 0) then
tChange = .False.
write (*,'(2x,a)') mySectionSeparator
end if
if (nDays == 0) then
t1 = " Today "
else if (nDays == -1) then
t1 = " Yesterday "
else if (nDays == 1) then
t1 = " Tomorrow "
else if (nDays < 0) then
write(unit=t1,fmt='(i4,a)')-ndays," days since" !In my days it was the ENCODE statement
else
write(unit=t1,fmt='(i4,a)')ndays," days until"
end if
write (*,'(2x,a,1x,a,1x,a,a)')ReminderTable(i)%rec_date,t1,ReminderTable(i)%rec_event
end do
write (*,'(2x,a///)')mySectionSeparator
end subroutine
end module
For a challenge I’ve tried to teach myself the Python programming language. It’s a big language with many features which I, as an ex-programmer from many decades ago, am unfamiliar with. But I’ve managed to write and test the code below, though I’m not sure I want to take this much further. I’ll see…..
import csv
from datetime import datetime
from operator import attrgetter
#======================================================
# A re-creation of my Reminder program from several decades ago!! My first Python program!
#
# Version 0.1 04-Mar-2021 In the beginning
# Version 0.2 07-Mar-2021 In the beginning
# Version 0.3 07-Mar-2021 I'm finally happy!
#======================================================
class Reminder:
def __init__(self, myRec):
self.Date = myRec[0]
self.DateTimeConversion = datetime.strptime(myRec[0],"%d-%b-%Y")
self.Message = myRec[1]
#======================================================
# Function GetReminderData to get the reminder data
#
#
# Read each record in the file
# Ignore any blank lines
# Add each record to the list myReminders
#
def GetReminderData(myFile,myReminders) :
with open(myFile) as csv_file:
csv_reader = csv.reader(csv_file, delimiter=',')
line_count = 0
for rec in csv_reader:
if rec == []:
pass
else:
line_count += 1
p = Reminder(rec)
myReminders.append(p)
csv_file.close()
#====================================================
# Function HowManyDaysDifference to get the number of days between today's date and a text date
# This is my weird code - what a palaver!
def HowManyDaysDifference(TextDate):
today_object = datetime.now()
mydate_in_datetime = datetime.strptime(TextDate,"%d-%b-%Y")
tdiff = mydate_in_datetime - today_object
diff_in_days = tdiff.days
if diff_in_days >= 0:
diff_in_days += 1
else:
tdiff = today_object - mydate_in_datetime
diff_in_days = -tdiff.days
return diff_in_days
#==================================================
# Function PrintList to nicely print the data
def PrintList ():
mySectionSeparator = "-" * 75
tChange = True
print ("\n" * 10 )
print (" Welcome to my Python Reminder program!")
print (mySectionSeparator)
for i in sorted(myReminders, key = attrgetter('DateTimeConversion')):
nDays = HowManyDaysDifference(i.Date)
if tChange and nDays > 0:
tChange = False
print (mySectionSeparator)
if nDays == 0:
t1 = " Today "
elif nDays == -1:
t1 = " Yesterday "
elif nDays == 1:
t1 = " Tomorrow "
elif nDays < 0:
t1 = '{:4d}'.format(-nDays) + " days since"
else:
t1 = '{:4d}'.format(nDays) + " days until"
t2 = i.Date +t1
print (t2,i.Message)
print (mySectionSeparator)
#=================================================
# This is the MAIN program
#
myFile = 'C:/Users/Mike/Documents/Documents/MyPythonCode/Reminder.dat'
myReminders = []
GetReminderData(myFile, myReminders)
PrintList()
things change 