|
forums.silverfrost.com Welcome to the Silverfrost forums
|
View previous topic :: View next topic |
Author |
Message |
dahowarduk
Joined: 24 Jun 2020 Posts: 11
|
Posted: Sat Jun 27, 2020 6:52 pm Post subject: Suppressing Zero ~ EXCEL type |
|
|
I have a sudoku type grid ,where the cells are defined as Integer :: Cell(9,9)
Where there is no value (yet) in the sudoku grid, that cell has the value of zero.
When I 'print' out the grid I get :-
0 0 0 0 0 0 0 0 0
0 0 0 0 1 6 2 0 5
0 0 8 0 0 0 0 7 6
0 0 0 0 6 0 0 3 0
0 1 0 7 8 0 0 0 0
0 6 0 0 0 4 0 2 8
0 5 0 0 0 0 0 0 0
0 0 1 4 0 7 0 6 2
0 8 6 0 0 3 0 4 9
What I want to print is the Sudoku grid with a 'space' for each zero
I'd also like to see the gridlines as well.
I'm 71 and trying to 'remember how to use Fortran...so be gentle with me.
Thanks |
|
Back to top |
|
|
Kenneth_Smith
Joined: 18 May 2012 Posts: 697 Location: Hamilton, Lanarkshire, Scotland.
|
Posted: Sat Jun 27, 2020 9:31 pm Post subject: |
|
|
Here is a possible solution, and I am sure you can improve it.
Ken
Code: | program t
implicit none
integer :: cell(1:9,1:9)
integer row, col
character(len=1) :: string_cell(1:9,1:9)
cell = transpose(reshape((/0,0,0,0,0,0,0,0,0, &
0,0,0,0,1,6,2,0,5, &
0,0,8,0,0,0,0,7,6, &
0,0,0,0,6,0,0,3,0, &
0,1,0,7,8,0,0,0,0, &
0,6,0,0,0,4,0,2,8, &
0,5,0,0,0,0,0,0,0, &
0,0,1,4,0,7,0,6,2, &
0,8,6,0,0,3,0,4,9/),shape(cell)))
! Copy current integer array cell to "equivalent" string_cell array, replacing 0 with " "
do row = 1, 9, 1
do col = 1, 9, 1
if (cell(row,col) .eq. 0) then
write(string_cell(row,col),'(A1)') ' '
else
write(string_cell(row,col),'(I1)') cell(row,col)
end if
end do
end do
! print out string cell array with "gridlines"
write(6,'(38("-"))')
do row = 1, 9, 1
write(6,'(9(" | ",A1)," |")') (string_cell(row,col),col=1,9)
write(6,'(38("-"))')
end do
end program t |
|
|
Back to top |
|
|
dahowarduk
Joined: 24 Jun 2020 Posts: 11
|
Posted: Sun Jun 28, 2020 10:50 am Post subject: |
|
|
Hi Ken
I got that working, with just a little bit of modification. Thanks.
In my 'learning fortran' book,it tells me the function CHAR(I), should convert an integer (I) to a character string...but that didn't seem to work.
My subroutine now is :-
SUBROUTINE DISPLAYTABLE (VALUE)
INTEGER VALUE(9,9)
CHARACTER (LEN=1):: CHARCELL(9,9)
DO ROW = 1,9
DO COL = 1, 9
IF (VALUE(ROW,COL) == 0) then
WRITE(CHARCELL(ROW,COL),'(A1)') ' '
ELSE
WRITE(CHARCELL(ROW,COL),'(I1)') VALUE(ROW,COL)
ENDIF
ENDDO
ENDDO
! print out string cell array with "gridlines"
WRITE(6,'(" ",37("="))')
DO ROW = 1, 9
WRITE(6,'(" ",9(" | ",A1)," |")') (CHARCELL(ROW,COL),COL=1,9)
I=ROW-(3*(INT(ROW)/3))
IF (I==0) THEN
WRITE(6,'(" ",37("="))')
ELSE
WRITE(6,'(" ",37("-"))')
ENDIF
ENDDO
END SUBROUTINE DISPLAYTABLE
The output is now fine other than I somehow need to get the "|" to be "||" for the 1st, 4th, 7th, 10th 'column' dividers, so that the output finally looks just like a Sudoku puzzle. any ideas?
Thanks |
|
Back to top |
|
|
Kenneth_Smith
Joined: 18 May 2012 Posts: 697 Location: Hamilton, Lanarkshire, Scotland.
|
Posted: Sun Jun 28, 2020 1:09 pm Post subject: |
|
|
This could be done by modifying the format specifiers, but it can be time consuming to get something that works when using the repeat counter(s). A better way might to augment a longer output string with the next output sub string (from your values stored in the string array), followed by another appropriate sub-string containing either �|� or �||�.
The code below illustrates the idea. I�ve also used the MOD intrinsic function to identify row and column numbers which are a multiple of 3, and the FTN95 extension CENTRE@ which is useful for aligning output text.
Code: | winapp
program t
implicit none
integer :: cell(1:9,1:9)
integer row, col
character(len=1) :: string_cell(1:9,1:9)
character(len=61) outstring
CHARACTER (LEN=61) CENTRE@
cell = transpose(reshape((/0,0,0,0,0,0,0,0,0, &
0,0,0,0,1,6,2,0,5, &
0,0,8,0,0,0,0,7,6, &
0,0,0,0,6,0,0,3,0, &
0,1,0,7,8,0,0,0,0, &
0,6,0,0,0,4,0,2,8, &
0,5,0,0,0,0,0,0,0, &
0,0,1,4,0,7,0,6,2, &
0,8,6,0,0,3,0,4,9/),shape(cell)))
! Copy current integer array cell to "equivalent" string_cell array, replacing 0 with " "
do row = 1, 9, 1
do col = 1, 9, 1
if (cell(row,col) .eq. 0) then
write(string_cell(row,col),'(A1)') ' '
else
write(string_cell(row,col),'(I1)') cell(row,col)
end if
end do
end do
! print out string cell array with "gridlines"
write(6,*) CENTRE@('+ S u d o k u +',61)
write(6,'(" ",59("="))')
do row = 1, 9, 1
! write(6,'(3(1(" || "),1(" "),2(" | ")),1(" || "))') !Uncomment to add extra rows
outstring = ' || '
do col = 1, 9, 1
if ( mod(col,3) .ne. 0) then
outstring = trim(outstring)//' '//string_cell(row,col)//' | '
else
outstring = trim(outstring)//' '//string_cell(row,col)//' || '
end if
end do
write(6,'(A61)') outstring
! write(6,'(3(1(" || "),1(" "),2(" | ")),1(" || "))') !Uncomment to add extra rows
if (mod(row,3).eq. 0 ) then
write(6,'(" ",59("="))')
else
write(6,'(" ",59("-"))')
end if
end do
end program t |
CHAR(I) does not convert an integer to a string, it returns the character at position I in the ASCII collating sequence. For example, the following code will print an uppercase A.
Code: | print'(A1)', row, char(65) |
|
|
Back to top |
|
|
mecej4
Joined: 31 Oct 2006 Posts: 1891
|
Posted: Sun Jun 28, 2020 1:15 pm Post subject: |
|
|
If you want the program to be a character mode application, you have to live with the limitations of the language (only 1-byte characters), the characters available ('║' is not available unless you use Unicode or the old IBM PC extended characters), or be ready to create and use a lot of tricks to get around these limitations.
If you are willing to use '|' and '�' in place of '║' and '|' , the following code may satisfy you.
Code: | program t
implicit none
integer :: cell(1:9,1:9)
integer i,j,k
character(len=1) :: string_cell(1:9,1:9)
character(len=1) :: sbar = char(124), bbar = char(166)
character(len=45) :: fmt = "(3(A1,1x,A1,1x,' ',1x,A1,1x,' ',1x,A1,1x),A1)"
character(len=37) :: eql = '====================================='
character(len=37) :: mil = '-------------------------------------'
cell = reshape((/0,0,0,0,0,0,0,0,0, &
0,0,0,0,1,6,2,0,5, &
0,0,8,0,0,0,0,7,6, &
0,0,0,0,6,0,0,3,0, &
0,1,0,7,8,0,0,0,0, &
0,6,0,0,0,4,0,2,8, &
0,5,0,0,0,0,0,0,0, &
0,0,1,4,0,7,0,6,2, &
0,8,6,0,0,3,0,4,9/),shape(cell))
do j = 1,2
i=index(fmt,' ')
fmt(i:i) = bbar
end do
! Copy current integer array cell to "equivalent" string_cell array, replacing 0 with " "
where (cell == 0)
string_cell = ' '
else where
string_cell = char(cell+48)
end where
print '(A)',eql
do k = 1,9
print fmt,(sbar,(string_cell(i,k),i=j*3-2,j*3),j=1,3),sbar
if (mod(k,3) == 0) then
print '(A)',eql
else
print '(A)',mil
endif
end do
end program t |
The output, viewed using an editor such as Plato:
Code: | =====================================
| � � | � � | � � |
-------------------------------------
| � � | � 1 � 6 | 2 � � 5 |
-------------------------------------
| � � 8 | � � | � 7 � 6 |
=====================================
| � � | � 6 � | � 3 � |
-------------------------------------
| � 1 � | 7 � 8 � | � � |
-------------------------------------
| � 6 � | � � 4 | � 2 � 8 |
=====================================
| � 5 � | � � | � � |
-------------------------------------
| � � 1 | 4 � � 7 | � 6 � 2 |
-------------------------------------
| � 8 � 6 | � � 3 | � 4 � 9 |
=====================================
|
The '�' will probably not be displayed properly in the console unless you have set CMD.EXE to use an appropriate font.
Side Note:
Quote: | In my 'learning fortran' book,it tells me the function CHAR(I), should convert an integer (I) to a character string...but that didn't seem to work. |
That is not quite correct. CHAR(I) returns the character whose ASCII sequence number (starting with 0) equals the value of the argument, I. The character '0' has ASCII sequence number Z'30', or 48 in decimal. That's the reason for the offset adjustment +48 that you can see in the code. |
|
Back to top |
|
|
LitusSaxonicum
Joined: 23 Aug 2005 Posts: 2390 Location: Yateley, Hants, UK
|
Posted: Sun Jun 28, 2020 7:24 pm Post subject: |
|
|
If I was asked to do this, I would do it with graphics. I would probably use a fixed-size CW+ %gr graphics area, and draw a grid with 2 pixel and 1 pixel lines to divide it up into the proper appearance of a conventional Sudoku grid. It would also be possible to use a larger font than the default and colour to show entries that don't work.
Eddie |
|
Back to top |
|
|
dahowarduk
Joined: 24 Jun 2020 Posts: 11
|
Posted: Sun Jun 28, 2020 8:06 pm Post subject: |
|
|
Sadly I'm 71 and never understood a word of your message. |
|
Back to top |
|
|
mecej4
Joined: 31 Oct 2006 Posts: 1891
|
Posted: Mon Jun 29, 2020 3:28 am Post subject: Re: |
|
|
dahowarduk wrote: | Sadly I'm 71 and never understood a word of your message. |
I do not know which of us you are addressing, but here is a link to a table of ASCII characters, if you are not familiar with the character set:
http://www.asciitable.com
In that table, look at the entry for the '5' character, and note that the sequence number of that character is 53 in decimal or 35 in hexadecimal. Thus, CHAR(53) is '5' and ICHAR('5') is 53. Similarly for the remaining decimal digits.
You may find it useful to read the description of the character type and associated intrinsic functions in Clive Page's book at https://www.star.le.ac.uk/~cgp/prof77.html#tth_sEc7 .
Some of the people posting in this forum are also older than 71, and age is rarely an issue. |
|
Back to top |
|
|
JohnCampbell
Joined: 16 Feb 2006 Posts: 2556 Location: Sydney
|
Posted: Mon Jun 29, 2020 6:42 am Post subject: |
|
|
Years ago I actually created a Sudoko solver using 9x9 %rd boxes, each with their own %lc handle. It is so long ago that I have forgotten the details.
The links below are to the program and a sudoko.txt data file.
You can step through looking for an available next box to fill,
or use start which will automatically solve the problem, testing alternate possible solutions.
The strategies are fairly limited, but it gets a solution.
"Start" and "step" work ok, but the other edit options don't work too well. (I was wanting to have an option of typing other values in then continue, but never finished that)
I don't regard it as cheating, as I wrote the program !
Anyway, this is a demonstrateable approach to layout for Sudoko.
No warranty !!
To compile (from memory, pre /64) is
ftn95 sudoko_v5 /debug /link
https://www.dropbox.com/s/pqw6raqk3ovbv2d/sudoku_v5.f95?dl=0
https://www.dropbox.com/s/nyta70xi6nnbgm4/sudoku.txt?dl=0 |
|
Back to top |
|
|
LitusSaxonicum
Joined: 23 Aug 2005 Posts: 2390 Location: Yateley, Hants, UK
|
Posted: Mon Jun 29, 2020 11:10 am Post subject: |
|
|
I suspect it was me, mentioning Clearwin. I'm 71 as well, and cannot see why age should factor into it.
By way of reply, Fortran of any variety is perhaps not the best of programming languages, and changes over the last half of its long life (it's 63) have concentrated on style and fashions in the computer world rather than the really fundamental deficiencies in a language for scientific and engineering work, which are (a) the lack of integrated graphics, and (b) easy tools for building user interfaces.
Right from its beginnings, FTN (then FTN77) met one of these deficiencies by including an integrated graphics package. In those days DOS could not access all the RAM that a PC might be equipped with without an 'extender' FTN77 came with such a piece of software called DBOS, and the graphics system of those times is colloquially referred to as 'DBOS graphics'.
In about 1992, the FTN developers launched another product, which they called Clearwin, which allowed Windows 95/98 applications to be developed in Fortran. FTN still used DBOS, and it was a bit complicated to use Clearwin (or CW for short). Eventually, DBOS was dropped and FTN used the Windows programming system in an integrated way, and Clearwin with some developments became Clearwin plus (or CW+).
The current version of FTN, which is FTN95, has a highly developed CW+ subsystem which you can use to create a Windows application, or just use parts of it to equip a program with graphics.
CW+ relies on things called format codes to generate the controls in a Windows application, and one of those is %gr, which enables the creation of an interactive graphics area.
My recommendation was to use the CW+ graphics facilities to generate an area in which your Sudoku table could be drawn and updated.I had a think about it last night, and a graphics area 540x540 pixels would give a 9x9 grid of Sudoku cells each 60x60 pixels, Graphics would be a good solution because you can blank a cell, or highlight parts of the cell array by the use of colour.
John Campbell's suggestion is also based round CW+, and is a cell array of numeric input boxes, which are specified using the format code %rd. That approach has the disadvantage of not allowing the box to be blanked once it has contained a number (it can be specified to be initially blank) and given your original request, that isn't so helpful, is it? (Although a working application seems to me to be extremely helpful).
%lc is a format code that returns to the programmer the identifier (or 'handle') for each data input box, so the program can discern which box has been altered.
Eddie
PS to Paul. Some years ago I asked if there might be a way to 're-blank' an input box once it had contained numbers or other content but you'd changed your mind and deleted them. This is one such an application where it would be useful. |
|
Back to top |
|
|
PaulLaidler Site Admin
Joined: 21 Feb 2005 Posts: 7933 Location: Salford, UK
|
Posted: Mon Jun 29, 2020 12:18 pm Post subject: |
|
|
Eddie
Try this...
Code: | include <WIN32API.INS>
integer(7) hwnd !From %lc
logical L
L = SetWindowText(hwnd, "") |
|
|
Back to top |
|
|
LitusSaxonicum
Joined: 23 Aug 2005 Posts: 2390 Location: Yateley, Hants, UK
|
Posted: Mon Jun 29, 2020 5:11 pm Post subject: |
|
|
Thanks Paul,
I probably missed that if you told me before!
Eddie |
|
Back to top |
|
|
|
|
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|