Skip to content

Commit b55a0fd

Browse files
jacobwilliamsjacobwilliams
authored
Merge pull request #273 from jacobwilliams/compress-vectors
Compress vectors
2 parents 609dc0c + a64a28e commit b55a0fd

File tree

4 files changed

+224
-27
lines changed

4 files changed

+224
-27
lines changed

‎src/json_file_module.F90‎

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -337,7 +337,8 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
337337
unescape_strings,&
338338
comment_char,&
339339
path_mode,&
340-
path_separator)
340+
path_separator,&
341+
compress_vectors)
341342

342343
implicit none
343344

@@ -353,7 +354,8 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
353354
unescape_strings,&
354355
comment_char,&
355356
path_mode,&
356-
path_separator)
357+
path_separator,&
358+
compress_vectors)
357359

358360
end subroutine initialize_json_core_in_file
359361
!*****************************************************************************************
@@ -416,7 +418,8 @@ function initialize_json_file(p,verbose,compact_reals,&
416418
unescape_strings,&
417419
comment_char,&
418420
path_mode,&
419-
path_separator) result(file_object)
421+
path_separator,&
422+
compress_vectors) result(file_object)
420423

421424
implicit none
422425

@@ -434,7 +437,8 @@ function initialize_json_file(p,verbose,compact_reals,&
434437
unescape_strings,&
435438
comment_char,&
436439
path_mode,&
437-
path_separator)
440+
path_separator,&
441+
compress_vectors)
438442

439443
if (present(p)) file_object%p => p
440444

‎src/json_initialize_arguments.inc‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,3 +38,9 @@
3838
!! Example: `.` [default] or `%`.
3939
!! Note: if `path_mode/=1`
4040
!! then this is ignored.
41+
logical(LK),intent(in),optional :: compress_vectors !! If true, then arrays of integers,
42+
!! nulls, doubles, and logicals are
43+
!! printed all on one line.
44+
!! [Note: `no_whitespace` will
45+
!! override this option if necessary].
46+
!! (Default is False).

‎src/json_value_module.F90‎

Lines changed: 115 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -222,6 +222,12 @@ module json_value_module
222222
!! Note: if `path_mode/=1`
223223
!! then this is ignored.
224224

225+
logical(LK) :: compress_vectors = .false. !! If true, then arrays of integers,
226+
!! nulls, doubles, & logicals are
227+
!! printed all on one line.
228+
!! [Note: `no_whitespace` will
229+
!! override this option if necessary]
230+
225231
contains
226232

227233
private
@@ -757,7 +763,8 @@ function initialize_json_core(verbose,compact_reals,&
757763
unescape_strings,&
758764
comment_char,&
759765
path_mode,&
760-
path_separator) result(json_core_object)
766+
path_separator,&
767+
compress_vectors) result(json_core_object)
761768

762769
implicit none
763770

@@ -773,7 +780,8 @@ function initialize_json_core(verbose,compact_reals,&
773780
unescape_strings,&
774781
comment_char,&
775782
path_mode,&
776-
path_separator)
783+
path_separator,&
784+
compress_vectors)
777785

778786
end function initialize_json_core
779787
!*****************************************************************************************
@@ -806,7 +814,8 @@ subroutine json_initialize(json,verbose,compact_reals,&
806814
unescape_strings,&
807815
comment_char,&
808816
path_mode,&
809-
path_separator)
817+
path_separator,&
818+
compress_vectors)
810819

811820
implicit none
812821

@@ -873,6 +882,11 @@ subroutine json_initialize(json,verbose,compact_reals,&
873882
json%path_separator = path_separator
874883
end if
875884

885+
! printing vectors in compressed form:
886+
if (present(compress_vectors)) then
887+
json%compress_vectors = compress_vectors
888+
end if
889+
876890
!Set the format for real numbers:
877891
! [if not changing it, then it remains the same]
878892

@@ -4759,7 +4773,8 @@ end subroutine json_print_2
47594773
! bug in v4.9 of the gfortran compiler.
47604774

47614775
recursive subroutine json_value_print(json,p,iunit,str,indent,&
4762-
need_comma,colon,is_array_element)
4776+
need_comma,colon,is_array_element,&
4777+
is_compressed_vector)
47634778

47644779
implicit none
47654780

@@ -4775,17 +4790,29 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
47754790
!! printed to this string rather than
47764791
!! a file. This mode is used by
47774792
!! [[json_value_to_string]].
4793+
logical(LK),intent(in),optional :: is_compressed_vector !! if True, this is an element
4794+
!! from an array being printed
4795+
!! on one line [default is False]
47784796

4779-
character(kind=CK,len=max_numeric_str_len) :: tmp !for val to string conversions
4797+
character(kind=CK,len=max_numeric_str_len) :: tmp !! for val to string conversions
47804798
character(kind=CK,len=:),allocatable :: s
47814799
type(json_value),pointer :: element
47824800
integer(IK) :: tab, i, count, spaces
47834801
logical(LK) :: print_comma
47844802
logical(LK) :: write_file, write_string
47854803
logical(LK) :: is_array
4804+
integer(IK) :: var_type,var_type_prev
4805+
logical(LK) :: is_vector !! if all elements of a vector
4806+
!! are scalars of the same type
47864807

47874808
if (.not. json%exception_thrown) then
47884809

4810+
if (present(is_compressed_vector)) then
4811+
is_vector = is_compressed_vector
4812+
else
4813+
is_vector = .false.
4814+
end if
4815+
47894816
!whether to write a string or a file (one or the other):
47904817
write_string = (iunit==unit2str)
47914818
write_file = .not. write_string
@@ -4890,13 +4917,43 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
48904917

48914918
count = json%count(p)
48924919

4920+
if (json%compress_vectors) then
4921+
! check to see if every child is the same type,
4922+
! and a scalar:
4923+
is_vector = .true.
4924+
var_type_prev = -1 ! an invalid value
4925+
nullify(element)
4926+
element => p%children
4927+
do i = 1, count
4928+
if (.not. associated(element)) then
4929+
call json%throw_exception('Error in json_value_print: '//&
4930+
'Malformed JSON linked list')
4931+
return
4932+
end if
4933+
! check variable type of all the children.
4934+
! They must all be the same, and a scalar.
4935+
call json%info(element,var_type=var_type)
4936+
if (var_type==json_object .or. &
4937+
var_type==json_array .or. &
4938+
(i>1 .and. var_type/=var_type_prev)) then
4939+
is_vector = .false.
4940+
exit
4941+
end if
4942+
var_type_prev = var_type
4943+
! get the next child the list:
4944+
element => element%next
4945+
end do
4946+
else
4947+
is_vector = .false.
4948+
end if
4949+
48934950
if (count==0) then !special case for empty array
48944951

48954952
call write_it( s//start_array//end_array, comma=print_comma )
48964953

48974954
else
48984955

4899-
call write_it( s//start_array )
4956+
call write_it( s//start_array, advance=(.not. is_vector) )
49004957

49014958
!if an array is in an array, there is an extra tab:
49024959
if (is_array) then
@@ -4915,30 +4972,44 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
49154972
end if
49164973

49174974
! recursive print of the element
4918-
call json%json_value_print(element, iunit=iunit, indent=tab,&
4919-
need_comma=i<count, is_array_element=.true., str=str)
4920-
4975+
if (is_vector) then
4976+
call json%json_value_print(element, iunit=iunit, indent=0,&
4977+
need_comma=i<count, is_array_element=.false., str=str,&
4978+
is_compressed_vector = .true.)
4979+
else
4980+
call json%json_value_print(element, iunit=iunit, indent=tab,&
4981+
need_comma=i<count, is_array_element=.true., str=str)
4982+
end if
49214983
! get the next child the list:
49224984
element => element%next
49234985

49244986
end do
49254987

49264988
!indent the closing array character:
4927-
call write_it( repeat(space, max(0,spaces-json%spaces_per_tab))//end_array,&
4928-
comma=print_comma )
4989+
if (is_vector) then
4990+
call write_it( end_array,comma=print_comma )
4991+
else
4992+
call write_it( repeat(space, max(0,spaces-json%spaces_per_tab))//end_array,&
4993+
comma=print_comma )
4994+
end if
49294995
nullify(element)
49304996

49314997
end if
49324998

49334999
case (json_null)
49345000

4935-
call write_it( s//null_str, comma=print_comma )
5001+
call write_it( s//null_str, comma=print_comma, &
5002+
advance=(.not. is_vector),&
5003+
space_after_comma=is_vector )
49365004

49375005
case (json_string)
49385006

49395007
if (allocated(p%str_value)) then
49405008
call write_it( s//quotation_mark// &
4941-
p%str_value//quotation_mark, comma=print_comma )
5009+
p%str_value//quotation_mark, &
5010+
comma=print_comma, &
5011+
advance=(.not. is_vector),&
5012+
space_after_comma=is_vector )
49425013
else
49435014
call json%throw_exception('Error in json_value_print:'//&
49445015
' p%value_string not allocated')
@@ -4948,16 +5019,22 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
49485019
case (json_logical)
49495020

49505021
if (p%log_value) then
4951-
call write_it( s//true_str, comma=print_comma )
5022+
call write_it( s//true_str, comma=print_comma, &
5023+
advance=(.not. is_vector),&
5024+
space_after_comma=is_vector )
49525025
else
4953-
call write_it( s//false_str, comma=print_comma )
5026+
call write_it( s//false_str, comma=print_comma, &
5027+
advance=(.not. is_vector),&
5028+
space_after_comma=is_vector )
49545029
end if
49555030

49565031
case (json_integer)
49575032

49585033
call integer_to_string(p%int_value,int_fmt,tmp)
49595034

4960-
call write_it( s//trim(tmp), comma=print_comma )
5035+
call write_it( s//trim(tmp), comma=print_comma, &
5036+
advance=(.not. is_vector),&
5037+
space_after_comma=is_vector )
49615038

49625039
case (json_double)
49635040

@@ -4968,7 +5045,9 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
49685045
call real_to_string(p%dbl_value,default_real_fmt,json%compact_real,tmp)
49695046
end if
49705047

4971-
call write_it( s//trim(tmp), comma=print_comma )
5048+
call write_it( s//trim(tmp), comma=print_comma, &
5049+
advance=(.not. is_vector),&
5050+
space_after_comma=is_vector )
49725051

49735052
case default
49745053

@@ -4983,26 +5062,36 @@ recursive subroutine json_value_print(json,p,iunit,str,indent,&
49835062

49845063
contains
49855064

4986-
subroutine write_it(s,advance,comma)
5065+
subroutine write_it(s,advance,comma,space_after_comma)
49875066

49885067
!! write the string to the file (or the output string)
49895068

49905069
implicit none
49915070

4992-
character(kind=CK,len=*),intent(in) :: s !! string to print
4993-
logical(LK),intent(in),optional :: advance !! to add line break or not
4994-
logical(LK),intent(in),optional :: comma !! print comma after the string
5071+
character(kind=CK,len=*),intent(in) :: s !! string to print
5072+
logical(LK),intent(in),optional :: advance !! to add line break or not
5073+
logical(LK),intent(in),optional :: comma !! print comma after the string
5074+
logical(LK),intent(in),optional :: space_after_comma !! print a space after the comma
49955075

49965076
logical(LK) :: add_comma !! if a delimiter is to be added after string
49975077
logical(LK) :: add_line_break !! if a line break is to be added after string
5078+
logical(LK) :: add_space !! if a space is to be added after the comma
49985079
character(kind=CK,len=:),allocatable :: s2 !! temporary string
49995080

50005081
if (present(comma)) then
50015082
add_comma = comma
50025083
else
50035084
add_comma = .false. !default is not to add comma
50045085
end if
5005-
5086+
if (json%no_whitespace) then
5087+
add_space = .false.
5088+
else
5089+
if (present(space_after_comma)) then
5090+
add_space = space_after_comma
5091+
else
5092+
add_space = .false. !default is not to add space
5093+
end if
5094+
end if
50065095
if (present(advance)) then
50075096
add_line_break = advance
50085097
else
@@ -5012,7 +5101,10 @@ subroutine write_it(s,advance,comma)
50125101

50135102
!string to print:
50145103
s2 = s
5015-
if (add_comma) s2 = s2 // delimiter
5104+
if (add_comma) then
5105+
s2 = s2 // delimiter
5106+
if (add_space) s2 = s2 // space
5107+
end if
50165108

50175109
if (write_file) then
50185110

0 commit comments

Comments
 (0)